home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Pascal / source / NIH Image V1.54 Source / Utilities.p < prev   
Encoding:
Text File  |  1994-01-27  |  68.0 KB  |  2,881 lines  |  [TEXT/PJMM]
  1. unit Utilities;
  2.  
  3. {Miscellaneous utility routines used by Image program}
  4.  
  5. interface
  6.  
  7.     uses
  8.         QuickDraw, Palettes, Picker, PrintTraps, globals;{SANE}
  9.  
  10.  
  11.  
  12.     procedure SetDialogItem (TheDialog: DialogPtr; item, value: integer);
  13.     procedure OutlineButton (theDialog: DialogPtr; itemNo, CornerRad: integer);
  14.     function GetDNum (TheDialog: DialogPtr; item: integer): LongInt;
  15.     function GetDString (TheDialog: DialogPtr; item: integer): str255;
  16.     procedure SetDNum (TheDialog: DialogPtr; item: integer; n: LongInt);
  17.     procedure GetWindowRect (w: WindowPtr; var wrect: rect);
  18.     procedure SetDReal (TheDialog: DialogPtr; item: integer; n: extended; fwidth: integer);
  19.     procedure SetDString (TheDialog: DialogPtr; item: integer; str: str255);
  20.     procedure DrawSItem (itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255);
  21.     function StringToReal (str: str255): extended;
  22.     function GetDReal (TheDialog: DialogPtr; item: integer): extended;
  23.     procedure RealToString (Val: extended; width, fwidth: integer; var Str: Str255);
  24.     procedure DrawReal (Val: extended; width, fwidth: integer);
  25.     procedure DrawJReal (hloc, vloc: integer; Val: extended; fwidth: integer);
  26.     procedure DrawLong (i: LongInt);
  27.     function GetInt (message: str255; default: integer; var Canceled: boolean): integer;
  28.     function GetReal (message: str255; default: extended; var Canceled: boolean): extended;
  29.     function OptionKeyDown: boolean;
  30.     function ShiftKeyDown: boolean;
  31.     function ControlKeyDown: boolean;
  32.     function CommandPeriod: boolean;
  33.     function SpaceBarDown: boolean;
  34.  
  35.     procedure SysResume;
  36.     procedure beep;
  37.     procedure PutMessage (str: str255);
  38.     procedure UnprotectLUT;
  39.     procedure LoadLUT (table: MyCSpecArray);
  40.     procedure SetupLutUndo;
  41.     procedure UndoLutChange;
  42.     procedure DisableDensitySlice;
  43.     procedure LoadInputLUT (address: ptr);
  44.     procedure ResetQuickCapture;
  45.     procedure ResetScionLG3;
  46.     procedure ResetFrameGrabber;
  47.     procedure wait (ticks: LongInt);
  48.     function GetScrapCount: integer;
  49.     procedure DisplayText (update: boolean);
  50.     procedure ScreenToOffscreen (var loc: point);
  51.     procedure OffscreenToScreen (var loc: point);
  52.     procedure OffScreenToScreenRect (var r: rect);
  53.     procedure UpdateScreen (MaskRect: rect);
  54.     procedure RestoreRoi;
  55.     procedure Undo;
  56.     procedure CheckOnOffItem (MenuH: MenuHandle; item, fst, lst: Integer);
  57.     procedure SetMenuItem (menuh: menuhandle; itemnum: integer; on: boolean);
  58.     function GetFontSize (item: integer): integer;
  59.     function MyGetPixel (h, v: integer): integer;
  60.     procedure PutPixel (h, v, value: integer);
  61.     procedure GetLine (h, v, count: integer; var line: LineType);
  62.     procedure GetColumn (hstart, vstart, count: integer; var data: LineType);
  63.     procedure PutColumn (hstart, vstart, count: integer; var data: LineType);
  64.     procedure PutLine (h, v, count: integer; var line: LineType);
  65.     procedure Show1Value (rvalue, CalibratedValue: extended);
  66.     procedure Show2PlotValues (x, y: real);
  67.     procedure Show2Values (current, total: LongInt);
  68.     procedure DrawXDimension (x: real; digits: integer);
  69.     procedure DrawYDimension (y: real; digits: integer);
  70.     procedure DrawRGB (index: integer);
  71.     procedure Show3Values (hloc, vloc, ivalue: LongInt);
  72.     procedure ShowDxDy (X, Y: real);
  73.     procedure PutChar (c: char);
  74.     procedure PutTab;
  75.     procedure PutString (str: str255);
  76.     procedure PutReal (n: extended; width, fwidth: integer);
  77.     procedure PutLong (n: LongInt; FieldWidth: integer);
  78.     procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
  79.     procedure ShowWatch;
  80.     procedure UpdatePicWindow;
  81.     procedure DoOperation (Operation: OpType);
  82.     procedure SaveRoi;
  83.     procedure KillRoi;
  84.     procedure Paste;
  85.     procedure ShowRoi;
  86.     procedure SetupUndo;
  87.     procedure SetupUndoFromClip;
  88.     procedure GetLoi (var x1, y1, x2, y2: real);
  89.     function NotRectangular: boolean;
  90.     function NotInBounds: boolean;
  91.     function NoSelection: boolean;
  92.     function NoUndo: boolean;
  93.     procedure CloneInfo (var OldInfo, NewInfo: PicInfo);
  94.     function NewPicWindow (name: str255; width, height: integer): boolean;
  95.     procedure GetAngle (dx, dy: real; var angle: real);
  96.     procedure MakeRegion;
  97.     procedure SelectAll (visible: boolean);
  98.     procedure EraseScreen;
  99.     procedure RestoreScreen;
  100.     procedure UpdateTitleBar;
  101.     procedure Unzoom;
  102.     procedure DrawBString (str: string);
  103.     procedure DrawMyGrowIcon (w: WindowPtr);
  104.     procedure PutMemoryAlert;
  105.     function GetBigHandle (NeededSize: LongInt): handle;
  106.     function GetImageMemory (SaveInfo: infoPtr; var PicBaseHandle: handle): ptr;
  107.     procedure UpdateAnalysisMenu;
  108.     procedure ExtendWindowsMenu (fname: str255; size: LongInt; wptr: WindowPtr);
  109.     procedure MakeNewWindow (name: str255);
  110.     function long2str (num: LongInt): str255;
  111.     procedure PutWarning;
  112.     procedure ScaleToFit;
  113.     procedure SetupRoiRect;
  114.     procedure SetForegroundColor (color: integer);
  115.     procedure SetBackgroundColor (color: integer);
  116.     procedure GetForegroundColor (event: EventRecord);
  117.     procedure GetBackgroundColor (event: EventRecord);
  118.     procedure GenerateValues;
  119.     procedure KillOperation;
  120.     procedure ScaleImageWindow (var trect: rect);
  121.     procedure InvertGrayLevels;
  122.     function TooWide: boolean;
  123.     procedure DrawTextString (str: str255; loc: point; just: integer);
  124.     procedure IncrementCounter;
  125.     procedure ClearResults (i: integer);
  126.     procedure UpdateFitEllipse;
  127.     procedure UpdateTextItems;
  128.     procedure MakeLowerCase (var str: str255);
  129.     function PutMessageWithCancel (str: str255): integer;
  130.     function CurrentWindow: integer;
  131.  
  132.  
  133. implementation
  134.  
  135.  
  136.     type
  137.         KeyPtrType = ^KeyMap;
  138.  
  139.  
  140.  
  141. {$PUSH}
  142. {$D-}
  143.  
  144.  
  145.     procedure MacsBug (str: str255);
  146.     inline
  147.         $abff;
  148.  
  149.  
  150.     procedure SetDialogItem;{(TheDialog:DialogPtr; item,value:integer)}
  151.         var
  152.             ItemType: integer;
  153.             ItemBox: rect;
  154.             ItemHdl: handle;
  155.     begin
  156.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  157.         SetCtlValue(ControlHandle(ItemHdl), value)
  158.     end;
  159.  
  160.  
  161.     procedure OutlineButton;{(theDialog: DialogPtr; itemNo, CornerRad: integer)}
  162.   {Draws a border around a button. 16 is the normal}
  163.   {corner radius for small buttons }
  164.         var
  165.             itemType: Integer;
  166.             itemBox: Rect;
  167.             itemHdl: Handle;
  168.             tempPort: GrafPtr;
  169.     begin
  170.         GetPort(tempPort);
  171.         SetPort(GrafPtr(theDialog));
  172.         GetDItem(theDialog, itemNo, itemType, itemHdl, itemBox);
  173.         PenSize(3, 3);
  174.         InSetRect(itemBox, -4, -4);
  175.         FrameRoundRect(itemBox, cornerRad, cornerRad);
  176.         PenSize(1, 1);
  177.         SetPort(tempPort);
  178.     end;
  179.  
  180.  
  181.     function GetDNum;{(TheDialog:DialogPtr; item:integer):LongInt}
  182.         var
  183.             ItemType: integer;
  184.             ItemBox: rect;
  185.             ItemHdl: handle;
  186.             str: str255;
  187.             n: LongInt;
  188.     begin
  189.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  190.         GetIText(ItemHdl, str);
  191.         StringToNum(str, n);
  192.         GetDNum := n;
  193.     end;
  194.  
  195.  
  196.     function GetDString;{(TheDialog:DialogPtr; item:integer):str255}
  197.         var
  198.             ItemType: integer;
  199.             ItemBox: rect;
  200.             ItemHdl: handle;
  201.             str: str255;
  202.     begin
  203.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  204.         GetIText(ItemHdl, str);
  205.         GetDString := str;
  206.     end;
  207.  
  208.  
  209.     procedure SetDNum;{(TheDialog:DialogPtr; item:integer; n:LongInt)}
  210.         var
  211.             ItemType: integer;
  212.             ItemBox: rect;
  213.             ItemHdl: handle;
  214.             str: str255;
  215.     begin
  216.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  217.         NumToString(n, str);
  218.         SetIText(ItemHdl, str)
  219.     end;
  220.  
  221.  
  222.     procedure GetWindowRect;{(w:WindowPtr; VAR wrect:rect)}
  223.   {Returns global coordinates of specified window.}
  224.     begin
  225.         if w <> nil then
  226.             wrect := WindowPeek(w)^.contRgn^^.rgnBBox
  227.         else
  228.             SetRect(wrect, 0, 0, 0, 0);
  229.     end;
  230.  
  231.  
  232.     procedure SetDReal;{(TheDialog:DialogPtr; item:integer; n:extended; fwidth:integer)}
  233.         var
  234.             ItemType: integer;
  235.             ItemBox: rect;
  236.             ItemHdl: handle;
  237.             str: str255;
  238.     begin
  239.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  240.         RealToString(n, 1, fwidth, str);
  241.         SetIText(ItemHdl, str)
  242.     end;
  243.  
  244.     procedure SetDString;{(TheDialog:DialogPtr; item:integer; str:str255)}
  245.         var
  246.             ItemType: integer;
  247.             ItemBox: rect;
  248.             ItemHdl: handle;
  249.     begin
  250.         GetDItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  251.         SetIText(ItemHdl, str)
  252.     end;
  253.  
  254.  
  255.     function GetDReal;{(TheDialog:DialogPtr; item:integer):extended}
  256.         var
  257.             str: str255;
  258.     begin
  259.         str := GetDString(TheDialog, item);
  260.         GetDReal := StringToReal(str);
  261.     end;
  262.  
  263.  
  264.     procedure DrawLong;{(i:LongInt)}
  265.         var
  266.             str: str255;
  267.     begin
  268.         NumToString(i, str);
  269.         DrawString(str);
  270.     end;
  271.  
  272.  
  273.     procedure RealToString;{(Val:extended; width,fwidth:integer; var Str:Str255)}
  274.   {Does number to string conversion equivalent to write(val:width:fwidth).}
  275. {var}
  276. {form: DecForm;}
  277.     begin
  278.         if fwidth < 0 then begin
  279.                 if val < 1.0 then
  280.                     fwidth := 4
  281.                 else if trunc(val) = val then
  282.                     fwidth := 0
  283.                 else
  284.                     fwidth := 2;
  285.             end;
  286.         str := StringOf(val : width : fwidth); {Use LSP StringOf function because SANE Num2Str bombs out under A/UX}
  287. {form.digits := fwidth;}
  288. {form.style := FixedDecimal;}
  289. {Num2Str(form, val, DecStr(str));}
  290. {while length(Str) < width do begin}
  291. {str := concat(' ', Str)}
  292. {end;}
  293.     end;
  294.  
  295.  
  296.     procedure DrawReal;{(Val:extended; width,fwidth:integer)}
  297.   {Displays a real(or integer) number at the current location in}
  298.   {a form equivalent to write(val:width:fwidth) }
  299.         var
  300.             str: str255;
  301.     begin
  302.         RealToString(val, width, fwidth, str);
  303.         DrawString(str);
  304.     end;
  305.  
  306.  
  307.     procedure DrawJReal (hloc, vloc: integer; val: extended; fwidth: integer);
  308.   {Draws right justified real number.}
  309.         var
  310.             str: str255;
  311.     begin
  312.         if (val >= 1000.0) or (val <= -1000.0) then
  313.             fwidth := 0;
  314.         RealToString(val, 1, fwidth, str);
  315.         MoveTo(hloc - StringWidth(str) - 2, vloc);
  316.         DrawString(str);
  317.     end;
  318.  
  319.  
  320.     function GetInt (message: str255; default: integer; var Canceled: boolean): integer;
  321.         const
  322.             NumberID = 3;
  323.         var
  324.             mylog: DialogPtr;
  325.             item: integer;
  326.             temp: LongInt;
  327.     begin
  328.         ParamText(message, '', '', '');
  329.         mylog := GetNewDialog(3000, nil, pointer(-1));
  330.         SetDNum(MyLog, NumberID, default);
  331.         SelIText(MyLog, NumberID, 0, 32767);
  332.         OutlineButton(MyLog, ok, 16);
  333.         repeat
  334.             ModalDialog(nil, item);
  335.         until (item = ok) or (item = cancel);
  336.         if item = ok then begin
  337.                 Canceled := false;
  338.                 temp := GetDNum(MyLog, NumberID);
  339.                 if (temp > -MaxInt) and (temp <= MaxInt) then
  340.                     GetInt := temp
  341.                 else begin
  342.                         SysBeep(1);
  343.                         GetInt := default
  344.                     end;
  345.             end {item=ok}
  346.         else begin
  347.                 Canceled := true;
  348.                 GetInt := default;
  349.             end;
  350.         DisposDialog(mylog);
  351.     end;
  352.  
  353.  
  354.     function GetReal (message: str255; default: extended; var Canceled: boolean): extended;
  355.         const
  356.             NumberID = 3;
  357.         var
  358.             mylog: DialogPtr;
  359.             item: integer;
  360.     begin
  361.         InitCursor;
  362.         ParamText(message, '', '', '');
  363.         mylog := GetNewDialog(3000, nil, pointer(-1));
  364.         SetDReal(MyLog, NumberID, default, 2);
  365.         SelIText(MyLog, NumberID, 0, 32767);
  366.         OutlineButton(MyLog, ok, 16);
  367.         repeat
  368.             ModalDialog(nil, item);
  369.         until (item = ok) or (item = cancel);
  370.         if item = ok then begin
  371.                 GetReal := GetDReal(MyLog, NumberID);
  372.                 Canceled := false;
  373.             end
  374.         else begin
  375.                 GetReal := default;
  376.                 Canceled := true;
  377.             end;
  378.         DisposDialog(mylog);
  379.     end;
  380.  
  381.  
  382.     function OptionKeyDown;{:boolean}
  383.         var
  384.             KeyPtr: KeyPtrType;
  385.             keys: array[0..3] of LongInt;
  386.     begin
  387.         KeyPtr := KeyPtrType(@keys);
  388.         GetKeys(KeyPtr^);
  389.         OptionKeyDown := (BAND(keys[1], 4)) <> 0;
  390.     end;
  391.  
  392.  
  393.     function ShiftKeyDown;{:boolean}
  394.         var
  395.             KeyPtr: KeyPtrType;
  396.             keys: array[0..3] of LongInt;
  397.     begin
  398.         KeyPtr := KeyPtrType(@keys);
  399.         GetKeys(KeyPtr^);
  400.         ShiftKeyDown := (BAND(keys[1], 1)) <> 0;
  401.     end;
  402.  
  403.  
  404.     function ControlKeyDown;{:boolean}
  405.         type
  406.             KeyPtrType = ^KeyMap;
  407.         var
  408.             KeyPtr: KeyPtrType;
  409.             keys: array[0..3] of LongInt;
  410.     begin
  411.         KeyPtr := KeyPtrType(@keys);
  412.         GetKeys(KeyPtr^);
  413.         ControlKeyDown := (BAND(keys[1], 8)) <> 0;
  414.     end;
  415.  
  416.  
  417.     function CommandPeriod;{:boolean}
  418.         type
  419.             KeyPtrType = ^KeyMap;
  420.         var
  421.             KeyPtr: KeyPtrType;
  422.             keys: array[0..3] of LongInt;
  423.     begin
  424.         KeyPtr := KeyPtrType(@keys);
  425.         GetKeys(KeyPtr^);
  426.         CommandPeriod := (BAND(keys[1], $808000)) = $808000;
  427.     end;
  428.  
  429.  
  430.     function SpaceBarDown: boolean;
  431.         var
  432.             KeyPtr: KeyPtrType;
  433.             keys: array[0..3] of LongInt;
  434.     begin
  435.         KeyPtr := KeyPtrType(@keys);
  436.         GetKeys(KeyPtr^);
  437.         SpaceBarDown := (BAND(keys[1], 512)) <> 0;
  438.     end;
  439.  
  440.  
  441.     procedure DrawSItem; {(itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255)}
  442. {Draw a string item in a dialog box.}
  443.         var
  444.             r: rect;
  445.             iType: integer;
  446.             ignore: handle;
  447.     begin
  448.         GetDItem(d, ItemNum, iType, ignore, r);
  449.         TextFont(fontrqst);
  450.         TextSize(sizerqst);
  451.         TextBox(pointer(ord(@s) + 1), length(s), r, TEJustRight);
  452.     end;
  453.  
  454.  
  455.     procedure SysResume;
  456.     begin
  457.         FlushEvents(EveryEvent, 0);
  458.         ExitToShell;
  459.     end;
  460.  
  461.  
  462.     procedure beep;
  463.     begin
  464.         SysBeep(1)
  465.     end;
  466.  
  467.  
  468.     procedure PutMessage;{(str:str255)}
  469.         var
  470.             ignore: integer;
  471.     begin
  472.         InitCursor;
  473.         ParamText(str, '', '', '');
  474.         Ignore := Alert(300, nil);
  475.     end;
  476.  
  477.     function GetFontSize;{(item:integer):integer}
  478.         var
  479.             TempSize: integer;
  480.             Canceled: boolean;
  481.     begin
  482.         case item of
  483.             1: 
  484.                 GetFontSize := 9;
  485.             2: 
  486.                 GetFontSize := 10;
  487.             3: 
  488.                 GetFontSize := 12;
  489.             4: 
  490.                 GetFontSize := 14;
  491.             5: 
  492.                 GetFontSize := 18;
  493.             6: 
  494.                 GetFontSize := 24;
  495.             7: 
  496.                 GetFontSize := 36;
  497.             8: 
  498.                 GetFontSize := 48;
  499.             9: 
  500.                 GetFontSize := 56;
  501.             10: 
  502.                 GetFontSize := 72;
  503.             12:  begin
  504.                     TempSize := GetInt('Font Size:', CurrentSize, Canceled);
  505.                     if TempSize < 1 then
  506.                         TempSize := 1;
  507.                     if TempSize > 1000 then
  508.                         TempSize := 1000;
  509.                     if not canceled then
  510.                         GetFontSize := TempSize
  511.                     else
  512.                         GetFontSize := CurrentSize;
  513.                 end;
  514.         end;
  515.     end;
  516.  
  517.  
  518.     procedure SetMenuItem; {(menuh:menuhandle; itemnum:integer; on:boolean)}
  519. {Enable or disable menuh's itemnum. }
  520.     begin
  521.         if on then
  522.             EnableItem(menuh, itemnum)
  523.         else
  524.             DisableItem(menuh, itemnum);
  525.         if ItemNum = 0 then
  526.             DrawMenuBar;
  527.     end;
  528.  
  529.  
  530.     procedure CheckOnOffItem;{(MenuH:MenuHandle; item,fst,lst:Integer)}
  531.         var
  532.             i: integer;
  533.     begin
  534.         for i := fst to lst do
  535.             if i = item then
  536.                 CheckItem(MenuH, i, true)
  537.             else
  538.                 CheckItem(MenuH, i, false);
  539.     end;
  540.  
  541.  
  542.     procedure UpdateTextItems;
  543.         var
  544.             size, i, MenuItem, FontID, item: integer;
  545.             FontName: str255;
  546.             FontFound, FoundIt: boolean;
  547.             str: str255;
  548.     begin
  549.         FontFound := false;
  550.         for item := 1 to NumFontItems do begin
  551.                 GetItem(FontMenuH, Item, FontName);
  552.                 GetFNum(FontName, FontID);
  553.                 if FontID = CurrentFontID then begin
  554.                         FontFound := true;
  555.                         CheckItem(FontMenuH, Item, True)
  556.                     end
  557.                 else
  558.                     CheckItem(FontMenuH, Item, false);
  559.             end;
  560.         if not FontFound then begin
  561.                 FoundIt := False;
  562.                 Item := 1;
  563.                 repeat
  564.                     GetItem(FontMenuH, Item, FontName);
  565.                     GetFNum(FontName, FontID);
  566.                     if FontID = Geneva then begin
  567.                             CheckItem(FontMenuH, Item, True);
  568.                             CurrentFontID := FontID;
  569.                             FoundIt := true;
  570.                         end;
  571.                     Item := Item + 1;
  572.                 until (Item > NumFontItems) or FoundIt;
  573.             end;
  574.  
  575.         for i := 1 to 10 do begin
  576.                 size := GetFontSize(i);
  577.                 if RealFont(CurrentFontID, size) then
  578.                     SetItemStyle(SizeMenuH, i, [outline])
  579.                 else
  580.                     SetItemStyle(SizeMenuH, i, [])
  581.             end;
  582.         NumToString(CurrentSize, str);
  583.         str := concat('Other[', str, ']…');
  584.         SetItem(SizeMenuH, 12, str);
  585.  
  586.         for i := TxPlain to TxShadow do
  587.             CheckItem(StyleMenuH, i, false);
  588.         if CurrentStyle = [] then
  589.             CheckItem(StyleMenuH, TxPlain, true)
  590.         else begin
  591.                 if Bold in CurrentStyle then
  592.                     CheckItem(StyleMenuH, TxBold, true);
  593.                 if Italic in CurrentStyle then
  594.                     CheckItem(StyleMenuH, TxItalic, true);
  595.                 if Underline in CurrentStyle then
  596.                     CheckItem(StyleMenuH, TxUnderline, true);
  597.                 if Outline in CurrentStyle then
  598.                     CheckItem(StyleMenuH, TxOutline, true);
  599.                 if Shadow in CurrentStyle then
  600.                     CheckItem(StyleMenuH, Txshadow, true);
  601.             end;
  602.  
  603.         case CurrentSize of
  604.             9: 
  605.                 MenuItem := 1;
  606.             10: 
  607.                 MenuItem := 2;
  608.             12: 
  609.                 MenuItem := 3;
  610.             14: 
  611.                 MenuItem := 4;
  612.             18: 
  613.                 MenuItem := 5;
  614.             24: 
  615.                 MenuItem := 6;
  616.             36: 
  617.                 MenuItem := 7;
  618.             48: 
  619.                 MenuItem := 8;
  620.             56: 
  621.                 MenuItem := 9;
  622.             72: 
  623.                 MenuItem := 10;
  624.             otherwise
  625.                 MenuItem := 12;
  626.         end;
  627.         CheckOnOffItem(SizeMenuH, MenuItem, 1, 12);
  628.  
  629.         case TextJust of
  630.             teJustLeft: 
  631.                 MenuItem := LeftItem;
  632.             teJustCenter: 
  633.                 MenuItem := CenterItem;
  634.             teJustRight: 
  635.                 MenuItem := RightItem;
  636.         end;
  637.         CheckOnOffItem(StyleMenuH, MenuItem, LeftItem, RightItem);
  638.  
  639.         if TextBack = NoBack then
  640.             MenuItem := NoBackgroundItem
  641.         else
  642.             MenuItem := WithBackgroundItem;
  643.         CheckOnOffItem(StyleMenuH, MenuItem, NoBackgroundItem, WithBackgroundItem);
  644.     end;
  645.  
  646.  
  647.     procedure LoadLUT (table: MyCSpecArray);
  648.         var
  649.             i, entry, screen: integer;
  650.             cPtr: ^cSpecArray;
  651.             SaveDevice: GDHandle;
  652.     begin
  653.         if nExtraColors > 0 then begin
  654.                 entry := FirstExtraColorsEntry;
  655.                 for i := 1 to nExtraColors do begin
  656.                         table[entry].rgb := ExtraColors[i];
  657.                         entry := entry + 1;
  658.                     end;
  659.             end;
  660.         if HighLightMode then begin
  661.                 table[1].rgb := Highlight1;
  662.                 table[254].rgb := Highlight254;
  663.             end;
  664.         for i := 1 to 254 do {Work around needed for 32-bit QuickDraw}
  665.             with table[i].rgb do
  666.                 if (red = 0) and (green = 0) and (blue = 0) then begin
  667.                         red := 256;
  668.                         green := 256;
  669.                         blue := 256;
  670.                     end;
  671.         cPtr := @table[1];
  672.         SaveDevice := GetGDevice;
  673.         for screen := 1 to nMonitors do begin
  674.                 SetGDevice(Monitors[screen]);
  675.                 for i := 1 to 254 do begin
  676.                         ProtectEntry(i, false);
  677.                         ReserveEntry(i, false);
  678.                     end;
  679.                 SetEntries(1, 253, cPtr^);
  680.             end;
  681.         SetGDevice(SaveDevice);
  682.     end;
  683.  
  684.  
  685.     procedure SetupLutUndo;
  686.     begin
  687.         with info^ do begin
  688.                 UndoInfo^.RedLut := RedLut;
  689.                 UndoInfo^.GreenLut := GreenLut;
  690.                 UndoInfo^.BlueLut := BlueLut;
  691.                 UndoInfo^.nColors := nColors;
  692.                 UndoInfo^.ColorStart := ColorStart;
  693.                 UndoInfo^.ColorEnd := ColorEnd;
  694.                 UndoInfo^.FillColor1 := FillColor1;
  695.                 UndoInfo^.FillColor2 := FillColor2;
  696.                 UndoInfo^.LutMode := LutMode;
  697.                 UndoInfo^.ColorTable := ColorTable;
  698.                 UndoInfo^.IdentityFunction := IdentityFunction;
  699.                 UndoInfo^.cTable := cTable;
  700.                 WhatToUndo := UndoLUT;
  701.             end;
  702.     end;
  703.  
  704.  
  705.     procedure UndoLutChange;
  706.     begin
  707.         with info^ do begin
  708.                 RedLut := UndoInfo^.RedLut;
  709.                 GreenLut := UndoInfo^.GreenLut;
  710.                 BlueLut := UndoInfo^.BlueLut;
  711.                 nColors := UndoInfo^.nColors;
  712.                 ColorStart := UndoInfo^.ColorStart;
  713.                 ColorEnd := UndoInfo^.ColorEnd;
  714.                 FillColor1 := UndoInfo^.FillColor1;
  715.                 FillColor2 := UndoInfo^.FillColor2;
  716.                 LutMode := UndoInfo^.LutMode;
  717.                 LutMode := UndoInfo^.LutMode;
  718.                 ColorTable := UndoInfo^.ColorTable;
  719.                 cTable := UndoInfo^.cTable;
  720.                 LoadLut(cTable);
  721.                 Thresholding := false;
  722.                 WhatToUndo := NothingToUndo;
  723.             end;
  724.     end;
  725.  
  726.  
  727.     procedure DisableDensitySlice;
  728.     begin
  729.         if DensitySlicing then begin
  730.                 DensitySlicing := false;
  731.                 UndoLutChange;
  732.             end;
  733.     end;
  734.  
  735.  
  736.     procedure LoadInputLUT;{(address:ptr)}
  737.         type
  738.             ilutType = packed array[0..1023] of byte;
  739.             ilutPtr = ^ilutType;
  740.         var
  741.             ilut: ilutPtr;
  742.             i: integer;
  743.     begin
  744.         ilut := ilutPtr(address);
  745.         if InvertVideo then begin
  746.                 for i := 0 to 255 do
  747.                     ilut^[i * 4] := i;
  748.                 ilut^[0] := 1;
  749.                 ilut^[255 * 4] := 254
  750.             end
  751.         else begin
  752.                 for i := 0 to 255 do
  753.                     ilut^[i * 4] := 255 - i;
  754.                 ilut^[0] := 254;
  755.                 ilut^[255 * 4] := 1
  756.             end;
  757.     end;
  758.  
  759.  
  760.     procedure ResetQuickCapture;
  761.         const
  762.             ilutOffset = $90000;
  763.     begin
  764.         ControlReg^ := 1; {reset}
  765.         while ControlReg^ < 0 do
  766.             ;
  767.         ChannelReg^ := VideoChannel * 64;
  768.         while ControlReg^ < 0 do
  769.             ;
  770.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  771.     end;
  772.  
  773.  
  774.     procedure ResetScionLG3;
  775.         const
  776.             ilutOffset = $80000;
  777.         var
  778.             SyncChannel, t: integer;
  779.     begin
  780.         ControlReg^ := 0;
  781.         BufferReg^ := 0;
  782.         if SyncMode = SeparateSync then
  783.             SyncChannel := 3
  784.         else
  785.             SyncChannel := VideoChannel;
  786.         t := band(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
  787.         ChannelReg^ := bor(LG3DataOut, bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
  788.         DacHighReg^ := LG3DacHigh;
  789.         DacLowReg^ := LG3DacLow;
  790.         DacAReg^ := LG3DacA;
  791.         DacBReg^ := LG3DacB;
  792.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  793.     end;
  794.  
  795.  
  796.     procedure ResetFrameGrabber;
  797.     begin
  798.         case FrameGrabber of
  799.             QuickCapture: 
  800.                 ResetQuickCapture;
  801.             ScionLG3: 
  802.                 ResetScionLG3;
  803.             otherwise
  804.                 ;
  805.         end;
  806.     end;
  807.  
  808.  
  809.     procedure wait;{(ticks:LongInt)}
  810.         var
  811.             SaveTicks: LongInt;
  812.     begin
  813.         SaveTicks := TickCount + ticks;
  814.         repeat
  815.         until TickCount > SaveTicks;
  816.     end;
  817.  
  818.  
  819.     function GetScrapCount;{:integer}
  820.         var
  821.             ScrapInfo: PScrapStuff;
  822.     begin
  823.         ScrapInfo := InfoScrap;
  824.         GetScrapCount := ScrapInfo^.ScrapCount;
  825.     end;
  826.  
  827.  
  828.     procedure DisplayText (update: boolean);
  829.         var
  830.             tPort: GrafPtr;
  831.             i, hstart, width, ff: integer;
  832.             MaskRect: rect;
  833.             p1, p2: point;
  834.     begin
  835.         if (info = NoInfo) or (not IsInsertionPoint) then
  836.             exit(DisplayText);
  837.         if update then
  838.             Undo;
  839.         GetPort(tPort);
  840.         SetPort(GrafPtr(Info^.osPort));
  841.         pmForeColor(ForegroundIndex);
  842.         pmBackColor(BackgroundIndex);
  843.         TextFont(CurrentFontID);
  844.         TextFace(CurrentStyle);
  845.         TextSize(CurrentSize);
  846.         if TextBack = NoBack then
  847.             TextMode(SrcOr)
  848.         else
  849.             TextMode(SrcCopy);
  850.         width := StringWidth(TextStr);
  851.         case TextJust of
  852.             teJustLeft: 
  853.                 hstart := TextStart.h;
  854.             teJustCenter: 
  855.                 hstart := TextStart.h - width div 2;
  856.             teJustRight: 
  857.                 hstart := TextStart.h - width;
  858.         end;
  859.         if hstart < 0 then
  860.             hstart := 0;
  861.         MoveTo(hstart, TextStart.v);
  862.         DrawString(TextStr);
  863.         GetPen(InsertionPoint);
  864.         ff := CurrentSize * 2;
  865.         p1.h := hstart - ff;
  866.         p1.v := TextStart.v - CurrentSize;
  867.         p2.h := TextStart.h + width + ff;
  868.         p2.v := TextStart.v + CurrentSize div 3;
  869.         Pt2Rect(p1, p2, MaskRect);
  870.         UpdateScreen(MaskRect);
  871.         SetPort(tPort);
  872.         Info^.changes := true;
  873.     end;
  874.  
  875.  
  876.     procedure OffScreenToScreenRect;{(VAR r:rect)}
  877.         var
  878.             p1, p2: point;
  879.     begin
  880.         with r do begin
  881.                 p1.h := left;
  882.                 p1.v := top;
  883.                 p2.h := right;
  884.                 p2.v := bottom;
  885.                 OffScreenToScreen(p1);
  886.                 OffScreenToScreen(p2);
  887.                 Pt2Rect(p1, p2, r);
  888.             end;
  889.     end;
  890.  
  891.  
  892.     procedure ScreenToOffscreen;{(VAR loc:point)}
  893.     begin
  894.         with loc, Info^ do begin
  895.                 h := SrcRect.left + trunc(h / magnification);
  896.                 v := SrcRect.top + trunc(v / magnification);
  897.             end;
  898.     end;
  899.  
  900.  
  901.     procedure OffscreenToScreen;{(VAR loc:point)}
  902.     begin
  903.         with loc, Info^ do begin
  904.                 h := trunc((h - SrcRect.left) * magnification);
  905.                 v := trunc((v - SrcRect.top) * magnification);
  906.             end;
  907.     end;
  908.  
  909.  
  910.     procedure UpdateScreen;{(MaskRect:rect)}
  911. {Refreshes the portion of the screen defined by}
  912. {MaskRect, where MaskRect is defined in offscreen coordinates.}
  913.         var
  914.             tPort: GrafPtr;
  915.             imag: integer;
  916.     begin
  917.         OffScreenToScreenRect(MaskRect);
  918.         with Info^ do
  919.             if info <> NoInfo then begin
  920.                     getPort(tPort);
  921.                     SetPort(wptr);
  922.                     pmForeColor(BlackIndex);
  923.                     pmBackColor(WhiteIndex);
  924.                     imag := trunc(magnification);
  925.                     InsetRect(MaskRect, -imag * 2 * LineWidth, -imag * 2 * LineWidth);
  926.                     InsetRect(MaskRect, 0, 0);
  927.                     RectRgn(MaskRgn, MaskRect);
  928.                     hlock(handle(osPort^.portPixMap));
  929.                     hlock(handle(CGrafPort(wptr^).PortPixMap));
  930.                     CopyBits(BitMapHandle(osPort^.PortPixMap)^^, BitMapHandle(CGrafPort(wptr^).PortPixMap)^^, SrcRect, wrect, SrcCopy, MaskRgn);
  931.                     hunlock(handle(osPort^.portPixMap));
  932.                     hunlock(handle(CGrafPort(wptr^).PortPixMap));
  933.                     SetPort(tPort);
  934.                 end;
  935.     end;
  936.  
  937.  
  938.     procedure RestoreRoi;
  939.     begin
  940.         with Info^ do begin
  941.                 SetupUndo;
  942.                 if RoiShowing then
  943.                     UpdateScreen(RoiRect);
  944.                 roiType := NoInfo^.roiType;
  945.                 RoiRect := NoInfo^.RoiRect;
  946.                 CopyRgn(NoInfo^.roiRgn, roiRgn);
  947.                 LX1 := NoInfo^.LX1;
  948.                 LY1 := NoInfo^.LY1;
  949.                 LX2 := NoInfo^.LX2;
  950.                 LY2 := NoInfo^.LY2;
  951.                 LAngle := NoInfo^.LAngle;
  952.                 RoiShowing := true;
  953.                 measuring := false;
  954.             end;
  955.     end;
  956.  
  957.  
  958.     procedure Undo;
  959.         var
  960.             SrcPtr: ptr;
  961.             line: integer;
  962.     begin
  963.         if info^.PixMapSize <> CurrentUndoSize then
  964.             exit(Undo);
  965.         if UndoFromClip then begin
  966.                 if info^.PixMapSize > ClipBufSize then
  967.                     exit(Undo);
  968.                 SrcPtr := ClipBuf;
  969.             end
  970.         else
  971.             SrcPtr := UndoBuf;
  972.         with info^ do
  973.             BlockMove(SrcPtr, PicBaseAddr, PixMapSize);
  974.         if UndoFromClip and RestoreUndoBuf then
  975.             with info^ do
  976.                 BlockMove(SrcPtr, UndoBuf, PixMapSize);
  977.         if RedoSelection then
  978.             RestoreRoi;
  979.     end;
  980.  
  981.  
  982.     function MyGetPixel (h, v: integer): integer;
  983.         type
  984.             packedUnsigned = packed record
  985.                     u: 0..255
  986.                 end;
  987.             pup = ^packedUnsigned;
  988.     begin
  989.         MyGetPixel := BackgroundIndex;
  990.         with Info^ do
  991.             if h >= 0 then
  992.                 if v >= 0 then
  993.                     if h < PixelsPerLine then
  994.                         if v < nlines then
  995.                             MyGetPixel := pup(Ord4(PicBaseAddr) + LongInt(v) * BytesPerRow + h)^.u;
  996.     end;
  997.  
  998.  
  999.     procedure PutPixel (h, v, value: integer);
  1000.         var
  1001.             addr: Ptr;
  1002.     begin
  1003.         with Info^ do
  1004.             if h >= 0 then
  1005.                 if v >= 0 then
  1006.                     if h < PixelsPerLine then
  1007.                         if v < nlines then begin
  1008.                                 addr := Ptr(Ord4(PicBaseAddr) + LongInt(v) * BytesPerRow + h);
  1009.                                 addr^ := value;
  1010.                             end;
  1011.     end;
  1012.  
  1013.  
  1014.     procedure GetLine (h, v, count: integer; var line: LineType);
  1015.         var
  1016.             offset: LongInt;
  1017.             p: ptr;
  1018.     begin
  1019.         with Info^ do begin
  1020.                 if (h < 0) or (v < 0) or ((h + count) > PixelsPerLine) or (v >= nlines) then begin
  1021.                         line := BlankLine^;
  1022.                         exit(GetLine);
  1023.                     end;
  1024.                 offset := LongInt(v) * BytesPerRow + h;
  1025.                 p := ptr(ord4(PicBaseAddr) + offset);
  1026.                 BlockMove(p, @line, count);
  1027.             end;
  1028.     end;
  1029.  
  1030.  
  1031.     procedure GetColumn (hstart, vstart, count: integer; var data: LineType);
  1032.         var
  1033.             col, pic, bpr: LongInt;
  1034.     begin
  1035.         if count > MaxLine then
  1036.             count := MaxLine;
  1037.         col := Ord4(@data);
  1038.         with Info^ do begin
  1039.                 bpr := BytesPerRow;
  1040.                 if hstart >= 0 then
  1041.                     if vstart >= 0 then
  1042.                         if hstart < PixelsPerLine then
  1043.                             if vstart <= nlines - count then begin
  1044.                                     pic := Ord4(PicBaseAddr) + LongInt(vstart) * bpr + hstart;
  1045.                                     while count > 0 do begin
  1046.                                             Ptr(col)^ := Ptr(pic)^;
  1047.                                             pic := pic + bpr;
  1048.                                             col := col + 1;
  1049.                                             count := count - 1;
  1050.                                         end;
  1051.                                 end;
  1052.             end;
  1053.         while count > 0 do begin
  1054.                 Ptr(col)^ := BackgroundIndex;
  1055.                 col := col + 1;
  1056.                 count := count - 1;
  1057.             end;
  1058.     end;
  1059.  
  1060.  
  1061.     procedure PutColumn (hstart, vstart, count: integer; var data: LineType);
  1062.         var
  1063.             col, pic, bpr: LongInt;
  1064.     begin
  1065.         col := Ord4(@data);
  1066.         with Info^ do begin
  1067.                 bpr := BytesPerRow;
  1068.                 if count > 0 then
  1069.                     if hstart >= 0 then
  1070.                         if vstart >= 0 then
  1071.                             if hstart < PixelsPerLine then begin
  1072.                                     if vstart > nlines - count then
  1073.                                         count := nlines - vstart;
  1074.                                     pic := Ord4(PicBaseAddr) + LongInt(vstart) * bpr + hstart;
  1075.                                     while count > 0 do begin
  1076.                                             Ptr(pic)^ := Ptr(col)^;
  1077.                                             pic := pic + bpr;
  1078.                                             col := col + 1;
  1079.                                             count := count - 1;
  1080.                                         end;
  1081.                                 end;
  1082.             end;
  1083.     end;
  1084.  
  1085.  
  1086.     procedure PutLine (h, v, count: integer; var line: LineType);
  1087.         var
  1088.             offset: LongInt;
  1089.             p: ptr;
  1090.     begin
  1091.         with Info^ do begin
  1092.                 if (h < 0) or (v < 0) or (v >= nlines) then
  1093.                     exit(PutLine);
  1094.                 if (h + count) > PixelsPerLine then
  1095.                     count := PixelsPerLine - h;
  1096.                 offset := LongInt(v) * BytesPerRow + h;
  1097.                 p := ptr(ord4(PicBaseAddr) + offset);
  1098.                 BlocKMove(@line, p, count);
  1099.             end;
  1100.     end;
  1101.  
  1102.  
  1103.     procedure Show1Value (rvalue, CalibratedValue: extended);
  1104.         var
  1105.             tPort: GrafPtr;
  1106.             hstart, vstart, ivalue: integer;
  1107.     begin
  1108.         hstart := ValuesHStart;
  1109.         vstart := ValuesVStart;
  1110.         GetPort(tPort);
  1111.         SetPort(ValuesWindow);
  1112.         TextSize(9);
  1113.         TextFont(Monaco);
  1114.         TextMode(SrcCopy);
  1115.         MoveTo(xValueLoc, vstart);
  1116.         if CalibratedValue <> NoValue then begin
  1117.                 DrawReal(CalibratedValue, 5, 2);
  1118.                 DrawString(' (');
  1119.                 DrawReal(rvalue, 3, 0);
  1120.                 DrawString(')');
  1121.             end
  1122.         else
  1123.             DrawReal(rvalue, 6, 2);
  1124.         DrawString('    ');
  1125.         SetPort(tPort);
  1126.     end;
  1127.  
  1128.  
  1129.     procedure Show2PlotValues (x, y: real);
  1130.         var
  1131.             tPort: GrafPtr;
  1132.             hstart, vstart, ivalue: integer;
  1133.     begin
  1134.         with info^ do begin
  1135.                 hstart := ValuesHStart;
  1136.                 vstart := ValuesVStart;
  1137.                 GetPort(tPort);
  1138.                 SetPort(ValuesWindow);
  1139.                 TextSize(9);
  1140.                 TextFont(Monaco);
  1141.                 TextMode(SrcCopy);
  1142.                 MoveTo(xValueLoc, vstart);
  1143.                 DrawXDimension(round(x), 0);
  1144.                 MoveTo(yValueLoc, vstart + 10);
  1145.                 DrawReal(y, 6, 2);
  1146.                 SetPort(tPort);
  1147.             end;
  1148.     end;
  1149.  
  1150.  
  1151.     procedure Show2Values (current, total: LongInt);
  1152.         var
  1153.             tPort: GrafPtr;
  1154.             hstart, vstart, ivalue: integer;
  1155.     begin
  1156.         hstart := ValuesHStart;
  1157.         vstart := ValuesVStart;
  1158.         GetPort(tPort);
  1159.         SetPort(ValuesWindow);
  1160.         TextSize(9);
  1161.         TextFont(Monaco);
  1162.         TextMode(SrcCopy);
  1163.         MoveTo(xValueLoc, vstart);
  1164.         DrawLong(current);
  1165.         DrawString('     ');
  1166.         MoveTo(yValueLoc, vstart + 10);
  1167.         DrawLong(total);
  1168.         DrawString('     ');
  1169.         SetPort(tPort);
  1170.     end;
  1171.  
  1172.  
  1173.     procedure DrawXDimension (x: real; digits: integer);
  1174.     begin
  1175.         with info^ do begin
  1176.                 if SpatiallyCalibrated then begin
  1177.                         DrawReal(x / xSpatialScale, 5, 2);
  1178.                         DrawChar(xUnit[1]);
  1179.                         DrawChar(xUnit[2]);
  1180.                         DrawString(' (');
  1181.                         DrawReal(x, 3, digits);
  1182.                         DrawString(')')
  1183.                     end
  1184.                 else
  1185.                     DrawReal(x, 1, digits);
  1186.                 DrawString('      ');
  1187.             end;
  1188.     end;
  1189.  
  1190.  
  1191.     procedure DrawYDimension (y: real; digits: integer);
  1192.     begin
  1193.         with info^ do begin
  1194.                 if SpatiallyCalibrated then begin
  1195.                         DrawReal(y / ySpatialScale, 5, 2);
  1196.                         DrawChar(xUnit[1]);
  1197.                         DrawChar(xUnit[2]);
  1198.                         DrawString(' (');
  1199.                         DrawReal(y, 3, digits);
  1200.                         DrawString(')')
  1201.                     end
  1202.                 else
  1203.                     DrawReal(y, 1, digits);
  1204.                 DrawString('      ');
  1205.             end;
  1206.     end;
  1207.  
  1208.  
  1209.     procedure DrawRGB (index: integer);
  1210.         var
  1211.             rStr, gStr, bStr: str255;
  1212.             TempRGB: rgbColor;
  1213.             i, entry: integer;
  1214.  
  1215.         procedure Convert (n: integer; var str: str255);
  1216.             var
  1217.                 i: integer;
  1218.         begin
  1219.             RealToString(n, 3, 0, str);
  1220.             for i := 1 to 3 do
  1221.                 if str[i] = ' ' then
  1222.                     str[i] := '0';
  1223.         end;
  1224.  
  1225.     begin
  1226.         TempRGB := cScreenPort^.portPixMap^^.pmTable^^.ctTable[index].rgb;
  1227.         with TempRGB do begin
  1228.                 Convert(band(bsr(red, 8), 255), rStr);
  1229.                 Convert(band(bsr(green, 8), 255), gStr);
  1230.                 Convert(band(bsr(blue, 8), 255), bStr);
  1231.                 DrawString(concat(rStr, ' ', gStr, ' ', bStr));
  1232.             end;
  1233.     end;
  1234.  
  1235.  
  1236.     procedure Show3Values;{(hloc,vloc,ivalue:LongInt)}
  1237.         var
  1238.             tPort: GrafPtr;
  1239.             hstart, vstart: integer;
  1240.     begin
  1241.         with info^ do begin
  1242.                 hstart := ValuesHStart;
  1243.                 vstart := ValuesVStart;
  1244.                 GetPort(tPort);
  1245.                 SetPort(ValuesWindow);
  1246.                 TextSize(9);
  1247.                 TextFont(Monaco);
  1248.                 TextMode(SrcCopy);
  1249.                 if hloc < 0 then
  1250.                     hloc := -hloc;
  1251.                 MoveTo(xValueLoc, vstart);
  1252.                 DrawXDimension(hloc, 0);
  1253.                 if InvertYCoordinates and (ivalue >= 0) then
  1254.                     vloc := PicRect.bottom - vloc - 1;
  1255.                 if vloc < 0 then
  1256.                     vloc := -vloc;
  1257.                 MoveTo(yValueLoc, vstart + 10);
  1258.                 DrawYDimension(vloc, 0);
  1259.                 DrawString('    ');
  1260.                 if ivalue >= 0 then begin
  1261.                         MoveTo(zValueLoc, vstart + 20);
  1262.                         if DensityCalibrated or (CurrentTool = PickerTool) then begin
  1263.                                 if CurrentTool = PickerTool then
  1264.                                     DrawRGB(ivalue)
  1265.                                 else
  1266.                                     DrawReal(cvalue[ivalue], 5, precision);
  1267.                                 DrawString(' (');
  1268.                                 DrawLong(ivalue);
  1269.                                 DrawString(')');
  1270.                             end
  1271.                         else
  1272.                             DrawLong(ivalue);
  1273.                     end;
  1274.                 DrawString('    ');
  1275.                 SetPort(tPort);
  1276.             end;
  1277.     end;
  1278.  
  1279.  
  1280.     procedure ShowDxDy (X, Y: real);
  1281.         var
  1282.             tPort: GrafPtr;
  1283.             hstart, vstart, ivalue: integer;
  1284.     begin
  1285.         with info^ do begin
  1286.                 hstart := ValuesHStart;
  1287.                 vstart := ValuesVStart;
  1288.                 GetPort(tPort);
  1289.                 SetPort(ValuesWindow);
  1290.                 TextSize(9);
  1291.                 TextFont(Monaco);
  1292.                 TextMode(SrcCopy);
  1293.                 MoveTo(xValueLoc, vstart);
  1294.                 DrawXDimension(x, 2);
  1295.                 MoveTo(yValueLoc, vstart + 10);
  1296.                 DrawYDimension(y, 2);
  1297.                 MoveTo(zValueLoc, vstart + 20);
  1298.                 if SpatiallyCalibrated then begin
  1299.                         DrawReal(sqrt(sqr(x / xSpatialScale) + sqr(y / ySpatialScale)), 5, 2);
  1300.                         DrawChar(xUnit[1]);
  1301.                         DrawChar(xUnit[2]);
  1302.                         DrawString(' (');
  1303.                         DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
  1304.                         DrawString(')')
  1305.                     end
  1306.                 else
  1307.                     DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
  1308.                 DrawString('    ');
  1309.                 SetPort(tPort);
  1310.             end;
  1311.     end;
  1312.  
  1313.  
  1314.     procedure PutChar;{(c:char)}
  1315.     begin
  1316.         if TextBufSize < MaxTextBufSize then begin
  1317.                 TextBufSize := TextBufSize + 1;
  1318.                 TextBufP^[TextBufSize] := c;
  1319.                 if c = cr then begin
  1320.                         TextBufColumn := 0;
  1321.                         TextBufLineCount := TextBufLineCount + 1
  1322.                     end
  1323.                 else
  1324.                     TextBufColumn := TextBufColumn + 1;
  1325.             end;
  1326.     end;
  1327.  
  1328.  
  1329.     procedure PutTab;
  1330.     begin
  1331.         if not printing then
  1332.             PutChar(tab)
  1333.     end;
  1334.  
  1335.  
  1336.     procedure PutString (str: str255);
  1337.         var
  1338.             i: integer;
  1339.     begin
  1340.         for i := 1 to length(str) do begin
  1341.                 if TextBufSize < MaxTextBufSize then
  1342.                     TextBufSize := TextBufSize + 1;
  1343.                 TextBufP^[TextBufSize] := str[i];
  1344.                 TextBufColumn := TextBufColumn + 1;
  1345.             end;
  1346.     end;
  1347.  
  1348.  
  1349.     procedure PutFString (str: str255; FieldWidth: integer);
  1350.         var
  1351.             LeadingSpaces: integer;
  1352.     begin
  1353.         LeadingSpaces := FieldWidth - length(str);
  1354.         if LeadingSpaces > 0 then
  1355.             str := concat(copy('            ', 1, LeadingSpaces), str);
  1356.         PutString(str);
  1357.     end;
  1358.  
  1359.  
  1360.     procedure PutReal;{(n:extended; width,fwidth:integer)}
  1361.         var
  1362.             str: str255;
  1363.     begin
  1364.         RealToString(n, width, fwidth, str);
  1365.         PutString(str);
  1366.     end;
  1367.  
  1368.  
  1369.     procedure PutLong (n: LongInt; FieldWidth: integer);
  1370.         var
  1371.             str: str255;
  1372.             LeadingSpaces: integer;
  1373.     begin
  1374.         NumToString(n, str);
  1375.         LeadingSpaces := FieldWidth - length(str);
  1376.         if LeadingSpaces > 0 then
  1377.             str := concat(copy('            ', 1, LeadingSpaces), str);
  1378.         PutString(str);
  1379.     end;
  1380.  
  1381.  
  1382.     procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
  1383.         var
  1384.             i, column, fwidth: integer;
  1385.             m: MeasurementTypes;
  1386.  
  1387.         procedure PutSequenceNumber;
  1388.         begin
  1389.             PutLong(i, 4);
  1390.             PutChar('.');
  1391.             PutTab;
  1392.         end;
  1393.  
  1394.         procedure PutUnits;
  1395.         begin
  1396.             if info^.SpatiallyCalibrated then begin
  1397.                     PutString('  (');
  1398.                     DrawChar(info^.xUnit[1]);
  1399.                     DrawChar(info^.xUnit[2]);
  1400.                     PutString(')')
  1401.                 end
  1402.             else
  1403.                 PutString('(Pixels)');
  1404.             PutChar(cr);
  1405.             PutChar(cr);
  1406.         end;
  1407.  
  1408.         procedure PutTabDelimeter;
  1409.         begin
  1410.             Column := Column + 1;
  1411.             if Column <> nListColumns then
  1412.                 PutTab;
  1413.         end;
  1414.  
  1415.     begin
  1416.         if mCount < 1 then begin
  1417.                 TextBufSize := 0;
  1418.                 TextBufLineCount := 0;
  1419.                 exit(CopyResultsToBuffer);
  1420.             end;
  1421.         ShowWatch;
  1422.         Headings := Headings or OptionKeyWasDown;
  1423.         TextBufSize := 0;
  1424.         TextBufColumn := 0;
  1425.         TextBufLineCount := 0;
  1426.         nListColumns := 0;
  1427.         for m := AreaM to StdDevM do
  1428.             if m in Measurements then
  1429.                 nListColumns := nListColumns + 1;
  1430.         if (xyLocM in measurements) or (nPoints > 0) then
  1431.             nListColumns := nListColumns + 2;
  1432.         if ModeM in measurements then
  1433.             nListColumns := nListColumns + 1;
  1434.         if (LengthM in measurements) or (nLengths > 0) then
  1435.             nListColumns := nListColumns + 1;
  1436.         if MajorAxisM in measurements then
  1437.             nListColumns := nListColumns + 1;
  1438.         if MinorAxisM in measurements then
  1439.             nListColumns := nListColumns + 1;
  1440.         if (AngleM in measurements) or (nAngles > 0) then
  1441.             nListColumns := nListColumns + 1;
  1442.         if IntDenM in measurements then
  1443.             nListColumns := nListColumns + 2;
  1444.         if MinMaxM in measurements then
  1445.             nListColumns := nListColumns + 2;
  1446.         if User1M in measurements then
  1447.             nListColumns := nListColumns + 1;
  1448.         if User2M in measurements then
  1449.             nListColumns := nListColumns + 1;
  1450.         with info^ do begin
  1451.                 fwidth := FieldWidth;
  1452.                 if Headings and (FirstCount = 1) then begin
  1453.                         PutFString(' ', 5);
  1454.                         PutTabDelimeter;
  1455.                         if AreaM in measurements then begin
  1456.                                 PutFString('Area', fwidth);
  1457.                                 PutTabDelimeter;
  1458.                             end;
  1459.                         if MeanM in measurements then begin
  1460.                                 PutFString('Mean', fwidth);
  1461.                                 PutTabDelimeter;
  1462.                             end;
  1463.                         if StdDevM in measurements then begin
  1464.                                 PutFString('S.D.', fwidth);
  1465.                                 PutTabDelimeter;
  1466.                             end;
  1467.                         if (xyLocM in measurements) or (nPoints > 0) then begin
  1468.                                 PutFString('X', fwidth);
  1469.                                 PutTabDelimeter;
  1470.                                 PutFString('Y', fwidth);
  1471.                                 PutTabDelimeter;
  1472.                             end;
  1473.                         if ModeM in measurements then begin
  1474.                                 PutFString('Mode', fwidth);
  1475.                                 PutTabDelimeter;
  1476.                             end;
  1477.                         if (LengthM in measurements) or (nLengths > 0) then begin
  1478.                                 PutFString('Length', fwidth);
  1479.                                 PutTabDelimeter;
  1480.                             end;
  1481.                         if MajorAxisM in measurements then begin
  1482.                                 PutFString(MajorLabel, fwidth);
  1483.                                 PutTabDelimeter;
  1484.                             end;
  1485.                         if MinorAxisM in measurements then begin
  1486.                                 PutFString(MinorLabel, fwidth);
  1487.                                 PutTabDelimeter;
  1488.                             end;
  1489.                         if (AngleM in measurements) or (nAngles > 0) then begin
  1490.                                 PutFString('Angle', fwidth);
  1491.                                 PutTabDelimeter;
  1492.                             end;
  1493.                         if IntDenM in measurements then begin
  1494.                                 PutFString('Int.Den.', fwidth + 2);
  1495.                                 PutTabDelimeter;
  1496.                                 PutFString('Back.', fwidth);
  1497.                                 PutTabDelimeter;
  1498.                             end;
  1499.                         if MinMaxM in measurements then begin
  1500.                                 PutFString('Min', fwidth);
  1501.                                 PutTabDelimeter;
  1502.                                 PutFString('Max', fwidth);
  1503.                                 PutTabDelimeter;
  1504.                             end;
  1505.                         if User1M in measurements then begin
  1506.                                 PutFString(User1Label, fwidth);
  1507.                                 PutTabDelimeter;
  1508.                             end;
  1509.                         if User2M in measurements then begin
  1510.                                 PutFString(User2Label, fwidth);
  1511.                                 PutTabDelimeter;
  1512.                             end;
  1513.                         PutChar(cr);
  1514.                         PutChar(cr);
  1515.                     end;
  1516.                 for i := FirstCount to LastCount do begin
  1517.                         column := 0;
  1518.                         if Headings then
  1519.                             PutSequenceNumber;
  1520.                         if AreaM in measurements then begin
  1521.                                 PutReal(mArea^[i], fwidth, precision);
  1522.                                 PutTabDelimeter;
  1523.                             end;
  1524.                         if MeanM in measurements then begin
  1525.                                 PutReal(mean^[i], fwidth, precision);
  1526.                                 PutTabDelimeter;
  1527.                             end;
  1528.                         if StdDevM in measurements then begin
  1529.                                 PutReal(sd^[i], fwidth, precision);
  1530.                                 PutTabDelimeter;
  1531.                             end;
  1532.                         if (xyLocM in measurements) or (nPoints > 0) then begin
  1533.                                 PutReal(xcenter^[i], fwidth, precision);
  1534.                                 PutTab;
  1535.                                 PutReal(ycenter^[i], fwidth, precision);
  1536.                                 PutTabDelimeter;
  1537.                             end;
  1538.                         if ModeM in measurements then begin
  1539.                                 PutReal(mode^[i], fwidth, precision);
  1540.                                 PutTabDelimeter;
  1541.                             end;
  1542.                         if (LengthM in measurements) or (nLengths > 0) then begin
  1543.                                 PutReal(plength^[i], fwidth, precision);
  1544.                                 PutTabDelimeter;
  1545.                             end;
  1546.                         if MajorAxisM in measurements then begin
  1547.                                 PutReal(MajorAxis^[i], fwidth, precision);
  1548.                                 PutTabDelimeter;
  1549.                             end;
  1550.                         if MinorAxisM in measurements then begin
  1551.                                 PutReal(MinorAxis^[i], fwidth, precision);
  1552.                                 PutTabDelimeter;
  1553.                             end;
  1554.                         if (AngleM in measurements) or (nAngles > 0) then begin
  1555.                                 PutReal(orientation^[i], fwidth, precision);
  1556.                                 PutTabDelimeter;
  1557.                             end;
  1558.                         if IntDenM in measurements then begin
  1559.                                 PutReal(IntegratedDensity^[i], fwidth + 2, precision);
  1560.                                 PutTabDelimeter;
  1561.                                 PutReal(idBackground^[i], fwidth, precision);
  1562.                                 PutTabDelimeter;
  1563.                             end;
  1564.                         if MinMaxM in measurements then begin
  1565.                                 PutReal(mMin^[i], fwidth, precision);
  1566.                                 PutTabDelimeter;
  1567.                                 PutReal(mMax^[i], fwidth, precision);
  1568.                                 PutTabDelimeter;
  1569.                             end;
  1570.                         if User1M in measurements then begin
  1571.                                 PutReal(User1^[i], fwidth, precision);
  1572.                                 PutTabDelimeter;
  1573.                             end;
  1574.                         if User2M in measurements then begin
  1575.                                 PutReal(User2^[i], fwidth, precision);
  1576.                                 PutTabDelimeter;
  1577.                             end;
  1578.                         PutChar(cr);
  1579.                     end; {for}
  1580.             end; {with}
  1581.     end;
  1582.  
  1583.  
  1584.     procedure ShowWatch;
  1585.     begin
  1586.         SetCursor(watch);
  1587.     end;
  1588.  
  1589.  
  1590.     procedure UpdatePicWindow;
  1591.         var
  1592.             tPort: GrafPtr;
  1593.     begin
  1594.         if info <> NoInfo then
  1595.             with Info^ do begin
  1596.                     getPort(tPort);
  1597.                     SetPort(wptr);
  1598.                     pmForeColor(BlackIndex);
  1599.                     pmBackColor(WhiteIndex);
  1600.                     hlock(handle(osPort^.portPixMap));
  1601.                     hlock(handle(CGrafPort(wptr^).PortPixMap));
  1602.                     CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(wptr^).PortPixMap)^^, SrcRect, wrect, SrcCopy, nil);
  1603.                     hunlock(handle(osPort^.portPixMap));
  1604.                     hunlock(handle(CGrafPort(wptr^).PortPixMap));
  1605.                     SetPort(tPort);
  1606.                     RoiUpdateTime := 0;
  1607.                 end;
  1608.     end;
  1609.  
  1610.  
  1611.     procedure DoOperation;{(Operation:OpType)}
  1612.         var
  1613.             tPort: GrafPtr;
  1614.             loc: point;
  1615.             width, height, SaveWidth: integer;
  1616.             tRect: rect;
  1617.     begin
  1618.         GetPort(tPort);
  1619.         with Info^ do begin
  1620.                 changes := true;
  1621.                 SetPort(GrafPtr(osPort));
  1622.                 pmForeColor(ForegroundIndex);
  1623.                 pmBackColor(BackgroundIndex);
  1624.                 PenNormal;
  1625.                 case Operation of
  1626.                     InvertOp: 
  1627.                         InvertRgn(roiRgn);
  1628.                     PaintOp: 
  1629.                         PaintRgn(roiRgn);
  1630.                     FrameOp:  begin
  1631.                             if (RoiType = LineRoi) or (RoiType = FreeLineRoi) or (RoiTYpe = SegLineRoi) then
  1632.                                 PenSize(1, 1)
  1633.                             else
  1634.                                 PenSize(LineWidth, LineWidth);
  1635.                             FrameRgn(roiRgn);
  1636.                         end;
  1637.                     EraseOp: 
  1638.                         EraseRgn(roiRgn);
  1639.                     PasteOp: 
  1640.                         Paste;
  1641.                     otherwise
  1642.                 end;
  1643.                 if not RoiShowing then
  1644.                     UpdateScreen(RoiRect);
  1645.                 if PixMapSize > UndoBufSize then
  1646.                     OpPending := false;
  1647.             end;
  1648.         SetPort(tPort);
  1649.     end;
  1650.  
  1651.  
  1652.     procedure SaveRoi;
  1653.     begin
  1654.         with info^ do
  1655.             if RoiType <> noRoi then begin
  1656.                     NoInfo^.roiType := roiType;
  1657.                     NoInfo^.RoiRect := RoiRect;
  1658.                     CopyRgn(roiRgn, NoInfo^.roiRgn);
  1659.                     NoInfo^.LX1 := LX1;
  1660.                     NoInfo^.LY1 := LY1;
  1661.                     NoInfo^.LX2 := LX2;
  1662.                     NoInfo^.LY2 := LY2;
  1663.                     NoInfo^.LAngle := LAngle;
  1664.                 end;
  1665.     end;
  1666.  
  1667.  
  1668.     procedure KillRoi;
  1669.         var
  1670.             trect: rect;
  1671.     begin
  1672.         with info^ do begin
  1673.                 if RoiShowing then begin
  1674.                         if OpPending then begin
  1675.                                 OpPending := false;
  1676.                                 DoOperation(CurrentOp);
  1677.                             end;
  1678.                         SaveRoi;
  1679.                         RoiShowing := false;
  1680.                         trect := RoiRect;
  1681.                         if RoiType = LineRoi then
  1682.                             InsetRect(trect, -RoiHandleSize, -RoiHandleSize);
  1683.                         UpdateScreen(trect);
  1684.                     end;
  1685.                 RoiType := NoRoi;
  1686.                 RoiUpdateTime := 0;
  1687.             end;
  1688.     end;
  1689.  
  1690.  
  1691.     procedure CaptureImage;
  1692.         var
  1693.             Timeout: LongInt;
  1694.     begin
  1695.         case FrameGrabber of
  1696.             QuickCapture:  begin
  1697.                     ControlReg^ := BitAnd($80, 255); {Start frame capture}
  1698.                     while ControlReg^ < 0 do
  1699.                         ;       {Wait for it to complete}
  1700.                 end;
  1701.             ScionLG3:  begin
  1702.                     TimeOut := TickCount + 30;  {1/2sec. timeout}
  1703.                     ControlReg^ := $80; {Start frame capture}
  1704.                     while BitAnd(ControlReg^, $80) = $00 do begin    {Wait for it to complete}
  1705.                             if TickCount > TimeOut then begin
  1706.                                     ControlReg^ := $00;
  1707.                                     leave
  1708.                                 end;
  1709.                         end;
  1710.                     ControlReg^ := $00;
  1711.                 end;
  1712.         end; {case}
  1713.     end;
  1714.  
  1715.  
  1716.     procedure Paste;
  1717.         var
  1718.             srcPort: cGrafPtr;
  1719.     begin
  1720.         if info = NoInfo then begin
  1721.                 beep;
  1722.                 exit(Paste)
  1723.             end;
  1724.         with Info^ do begin
  1725.                 if not RoiShowing then
  1726.                     exit(Paste);
  1727.                 if PasteTransferMode = SrcCopy then begin
  1728.                         pmForeColor(BlackIndex);
  1729.                         pmBackColor(WhiteIndex);
  1730.                     end;
  1731.                 srcPort := ClipBufInfo^.osPort;
  1732.                 if LivePasteMode then
  1733.                     if ((WhatsOnClip = CameraPic) or (WhatsOnClip = LivePic)) and (PictureType <> FrameGrabberType) then begin
  1734.                             CaptureImage;
  1735.                             srcPort := fgPort;
  1736.                         end;
  1737.                 hlock(handle(srcPort^.portPixMap));
  1738.                 hlock(handle(osPort^.portPixMap));
  1739.                 CopyBits(BitMapHandle(srcPort^.portPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, ClipBufInfo^.RoiRect, RoiRect, PasteTransferMode, roiRgn);
  1740.                 hunlock(handle(srcPort^.portPixMap));
  1741.                 hunlock(handle(osPort^.PortPixMap));
  1742.                 if PasteTransferMode = SrcCopy then begin
  1743.                         pmForeColor(ForegroundIndex);
  1744.                         pmBackColor(BackgroundIndex);
  1745.                     end;
  1746.             end;
  1747.     end;
  1748.  
  1749.  
  1750.     procedure ShowRoi;
  1751.     begin
  1752.         with info^ do
  1753.             if RoiType <> NoRoi then begin
  1754.                     SetupUndo;
  1755.                     RoiShowing := true;
  1756.                 end;
  1757.     end;
  1758.  
  1759.  
  1760.     procedure SetupUndo;
  1761.         var
  1762.             line: integer;
  1763.     begin
  1764.         WhatToUndo := NothingToUndo;
  1765.         if info = NoInfo then begin
  1766.                 CurrentUndoSize := 0;
  1767.                 exit(SetupUndo)
  1768.             end;
  1769.         with info^ do begin
  1770.                 if PixMapSize > UndoBufSize then begin
  1771.                         CurrentUndoSize := 0;
  1772.                         exit(SetupUndo)
  1773.                     end;
  1774.                 if OpPending then begin
  1775.                         DoOperation(CurrentOp);
  1776.                         OpPending := false;
  1777.                     end;
  1778.                 CurrentUndoSize := PixMapSize;
  1779.                 BlockMove(PicBaseAddr, UndoBuf, PixMapSize);
  1780.                 UndoFromClip := false;
  1781.                 RedoSelection := false;
  1782.             end;
  1783.     end;
  1784.  
  1785.  
  1786.     procedure SetupUndoFromClip;
  1787.         var
  1788.             line: integer;
  1789.     begin
  1790.         WhatToUndo := NothingToUndo;
  1791.         if info = NoInfo then begin
  1792.                 CurrentUndoSize := 0;
  1793.                 exit(SetupUndoFromClip)
  1794.             end;
  1795.         with info^ do begin
  1796.                 if PixMapSize > ClipBufSize then begin
  1797.                         CurrentUndoSize := 0;
  1798.                         exit(SetupUndoFromClip)
  1799.                     end;
  1800.                 if OpPending then begin
  1801.                         DoOperation(CurrentOp);
  1802.                         OpPending := false;
  1803.                     end;
  1804.                 CurrentUndoSize := PixMapSize;
  1805.                 BlockMove(PicBaseAddr, ClipBuf, PixMapSize);
  1806.             end;
  1807.         WhatsOnClip := NothingOnClip;
  1808.         UndofromClip := true;
  1809.         RedoSelection := false;
  1810.     end;
  1811.  
  1812.  
  1813.     function NoSelection;{:boolean}
  1814.     begin
  1815.         if Info = NoInfo then begin
  1816.                 beep;
  1817.                 NoSelection := true;
  1818.                 exit(NoSelection);
  1819.             end;
  1820.         if not Info^.RoiShowing then begin
  1821.                 PutMessage('Please use a selection tool to make a selection or use the Select All command.');
  1822.                 macro := false;
  1823.             end;
  1824.         NoSelection := not Info^.RoiShowing;
  1825.     end;
  1826.  
  1827.  
  1828.     function NotRectangular;{:boolean}
  1829.     begin
  1830.         with info^ do
  1831.             if RoiShowing and (RoiType <> RectRoi) then begin
  1832.                     PutMessage('This operation requires a rectangular selection.');
  1833.                     NotRectangular := true;
  1834.                     macro := false;
  1835.                 end
  1836.             else
  1837.                 NotRectangular := false;
  1838.     end;
  1839.  
  1840.  
  1841.     procedure GetLoi (var x1, y1, x2, y2: real);
  1842.     begin
  1843.         with info^, info^.RoiRect do begin
  1844.                 x1 := left + LX1;
  1845.                 y1 := top + LY1;
  1846.                 x2 := left + LX2;
  1847.                 y2 := top + LY2;
  1848.             end;
  1849.     end;
  1850.  
  1851.  
  1852.     function NotInBounds;{:boolean}
  1853.         var
  1854.             x1, y1, x2, y2: real;
  1855.     begin
  1856.         NotInBounds := false;
  1857.         with info^, info^.RoiRect do
  1858.             if RoiShowing then begin
  1859.                     if RoiType = LineRoi then begin
  1860.                             GetLoi(x1, y1, x2, y2);
  1861.                             if (x1 >= 0.0) and (y1 >= 0.0) and (x2 <= right) and (y2 <= bottom) then
  1862.                                 exit(NotInBounds);
  1863.                         end;
  1864.                     if (left < 0) or (top < 0) or (right > PicRect.right) or (bottom > PicRect.bottom) then begin
  1865.                             PutMessage('This operation requires the selection to be entirely within the image.');
  1866.                             NotInBounds := true;
  1867.                             macro := false;
  1868.                         end;
  1869.                 end;
  1870.     end;
  1871.  
  1872.  
  1873.     function NoUndo: boolean;
  1874.         var
  1875.             ImageTooLarge: boolean;
  1876.     begin
  1877.         with info^ do
  1878.             ImageTooLarge := (PixMapSize > ClipBufSize) or (PixMapSize > UndoBufSize);
  1879.         if ImageTooLarge then
  1880.             PutMessage('This operation requires that the Undo and Clipboard buffers be at least as large as the image.');
  1881.         NoUndo := ImageTooLarge;
  1882.     end;
  1883.  
  1884.  
  1885.     procedure PutMemoryAlert;
  1886.     begin
  1887.         PutMessage('Sorry, but there is not enough memory available to open this image. Try closing some windows.');
  1888.         macro := false;
  1889.     end;
  1890.  
  1891.  
  1892.     procedure CompactMemory;
  1893.         var
  1894.             size: LongInt;
  1895.             TempInfo: InfoPtr;
  1896.             i: integer;
  1897.     begin
  1898.         for i := 1 to nPics do begin
  1899.                 TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  1900.                 hunlock(TempInfo^.PicBaseHandle)
  1901.             end;
  1902.         size := 4000000;
  1903.         PurgeMem(size);
  1904.         size := CompactMem(size);
  1905.         for i := 1 to nPics do begin
  1906.                 TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  1907.                 with TempInfo^ do begin
  1908.                         hlock(PicBaseHandle);
  1909.                         PicBaseAddr := StripAddress(PicBaseHandle^);
  1910.                         osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
  1911.                     end;
  1912.             end;
  1913.     end;
  1914.  
  1915.  
  1916.     function GetBigHandle (NeededSize: LongInt): handle;
  1917. {Allocates a handle and guarantees MinFree contiguous free bytes after allocation . }
  1918. {Does NOT arrange for the new handle to be unlocked during CompactMemory. }
  1919. {GetBigHandle returns nil if CompactMemory fails to obtain enough contiguous free space . }
  1920.         var
  1921.             h: handle;
  1922.             FreeMem: LongInt;
  1923.     begin
  1924.         h := NewHandle(NeededSize);
  1925.         FreeMem := MaxBlock;
  1926.         if (h = nil) or (FreeMem < MinFree) then begin
  1927.                 if h <> nil then
  1928.                     DisposHandle(h);
  1929.                 CompactMemory;
  1930.                 h := NewHandle(NeededSize);
  1931.                 FreeMem := MaxBlock;
  1932.             end;
  1933.         if (h = nil) or (FreeMem < MinFree) then begin
  1934.                 if h <> nil then
  1935.                     DisposHandle(h);
  1936.                 h := nil;
  1937.             end;
  1938.         GetBigHandle := h;
  1939.     end;
  1940.  
  1941.  
  1942.     function GetImageMemory (SaveInfo: infoPtr; var PicBaseHandle: handle): ptr;
  1943. {Allocates memory for the PixMap of new image windows. SaveInfo points to the InfoRec of the previous window.}
  1944. {A handle is used, rather than a pointer, since NewPtr(particularly on the ci and fx) is rediculously slow.}
  1945.         var
  1946.             h: handle;
  1947.             NeededSize: LongInt;
  1948.     begin
  1949.         with info^ do begin
  1950.                 if odd(PixelsPerLine) then
  1951.                     BytesPerRow := PixelsPerLine + 1
  1952.                 else
  1953.                     BytesPerRow := PixelsPerLine;
  1954.                 PixMapSize := LongInt(nlines) * BytesPerRow;
  1955.                 ImageSize := LongInt(nlines) * PixelsPerLine;
  1956.                 NeededSize := PixMapSize;
  1957.             end;
  1958.         h := GetBigHandle(NeededSize);
  1959.         if h = nil then begin
  1960.                 PutMemoryAlert;
  1961.                 DisposPtr(pointer(Info));
  1962.                 Info := SaveInfo;
  1963.                 GetImageMemory := nil;
  1964.                 exit(GetImageMemory);
  1965.             end;
  1966.         PicBaseHandle := h;
  1967.         hlock(PicBaseHandle);
  1968.         GetImageMemory := StripAddress(PicBaseHandle^);
  1969.     end;
  1970.  
  1971.  
  1972.     procedure UpdateAnalysisMenu;
  1973.         var
  1974.             ShowItems: boolean;
  1975.             i: integer;
  1976.     begin
  1977.         ShowItems := Info <> NoInfo;
  1978.         SetMenuItem(AnalyzemenuH, MeasureItem, ShowItems);
  1979.         SetMenuItem(AnalyzemenuH, AnalyzeItem, ShowItems);
  1980.         SetMenuItem(AnalyzemenuH, HistogramItem, ShowItems);
  1981.         SetMenuItem(AnalyzemenuH, PlotItem, ShowItems);
  1982.         SetMenuItem(AnalyzemenuH, PlotSurfaceItem, ShowItems);
  1983.         SetMenuItem(AnalyzemenuH, SetScaleItem, ShowItems);
  1984.         SetMenuItem(AnalyzemenuH, CalibrateItem, ShowItems);
  1985.         SetMenuItem(AnalyzemenuH, RedoItem, mCount > 0);
  1986.         SetMenuItem(AnalyzemenuH, DeleteItem, mCount > 0);
  1987.         SetMenuItem(AnalyzemenuH, RestoreItem, ShowItems and (NoInfo^.RoiType <> NoRoi));
  1988.         SetMenuItem(AnalyzemenuH, MarkItem, info^.RoiShowing);
  1989.     end;
  1990.  
  1991.  
  1992.     procedure ExtendWindowsMenu;{(fname:str255; size:LongInt; wptr:WindowPtr)}
  1993.         var
  1994.             str, SizeStr: str255;
  1995.     begin
  1996.         if nPics < MaxPics then begin
  1997.                 nPics := nPics + 1;
  1998.                 PicWindow[nPics] := wptr;
  1999.                 NumToString((size + 511) div 1024, SizeStr);
  2000.                 str := concat(fname, '  ', SizeStr, 'K');
  2001.                 AppendMenu(WindowsMenuH, ' ');
  2002.                 SetItem(WindowsMenuH, nPics + WindowsMenuItems + nTextWindows, str);
  2003.                 InsertMenu(WindowsMenuH, 0);
  2004.             end;
  2005.     end;
  2006.  
  2007.  
  2008.     procedure InvertGrayLevels;
  2009.     begin
  2010.         with info^ do begin
  2011.                 DensityCalibrated := true;
  2012.                 nCoefficients := 2;
  2013.                 fit := StraightLine;
  2014.                 Coefficient[1] := 255.0;
  2015.                 Coefficient[2] := -1.0;
  2016.                 ZeroClip := false;
  2017.                 UpdateTitleBar;
  2018.             end;
  2019.     end;
  2020.  
  2021.  
  2022.     procedure GetAngle (dx, dy: real; var angle: real);
  2023.         var
  2024.             quadrant: (q1, q2orq3, q4);
  2025.     begin
  2026.         if dx <> 0.0 then
  2027.             angle := arctan(dy / dx)
  2028.         else begin
  2029.                 if dy >= 0.0 then
  2030.                     angle := pi / 2.0
  2031.                 else
  2032.                     angle := -pi / 2.0
  2033.             end;
  2034.         angle := (180.0 / pi) * angle;
  2035.         if (dx >= 0.0) and (dy >= 0.0) then
  2036.             quadrant := q1
  2037.         else if dx < 0.0 then
  2038.             quadrant := q2orq3
  2039.         else
  2040.             quadrant := q4;
  2041.         case quadrant of
  2042.             q1: 
  2043.                 ;
  2044.             q2orq3: 
  2045.                 angle := angle + 180.0;
  2046.             q4: 
  2047.                 angle := angle + 360.0;
  2048.         end;
  2049.     end;
  2050.  
  2051.  
  2052.     procedure MakeRegion;
  2053.         var
  2054.             deltax, deltay, x1, y1, x2, y2, xt, yt: integer;
  2055.             dx, dy, pAngle: real;
  2056.             add: boolean;
  2057.             tPort: GrafPtr;
  2058.     begin
  2059.         with info^ do begin
  2060.                 GetPort(tPort);
  2061.                 SetPort(wptr);
  2062.                 OpenRgn;
  2063.                 case RoiType of
  2064.                     LineRoi:  begin
  2065.                             GetAngle(LX2 - LX1, LY1 - LY2, LAngle);
  2066.                             x1 := round(LX1);
  2067.                             y1 := round(LY1);
  2068.                             x2 := round(LX2);
  2069.                             y2 := round(LY2);
  2070.                             if (x1 = x2) and (y1 = y2) then begin
  2071.                                     MoveTo(x1, y1);
  2072.                                     LineTo(x1 + 1, y1);
  2073.                                     LineTo(x1 + 1, y1 + 1);
  2074.                                     LineTo(x1, y1 + 1);
  2075.                                     LineTo(x1, y1);
  2076.                                 end
  2077.                             else begin
  2078.                                     add := (LAngle > 90.0) and (LAngle <= 270.0);
  2079.                                     pAngle := (LAngle / 180.0) * pi;
  2080.                                     if add then
  2081.                                         pAngle := pAngle + pi / 2.0
  2082.                                     else
  2083.                                         pAngle := pAngle - pi / 2.0;
  2084.                                     dx := cos(pAngle) * LineWidth;
  2085.                                     dy := -sin(pAngle) * LineWidth;
  2086.                                     MoveTo(x1, y1);
  2087.                                     LineTo(round(x1 + dx), round(y1 + dy));
  2088.                                     LineTo(round(x2 + dx), round(y2 + dy));
  2089.                                     LineTo(x2, y2);
  2090.                                     LineTo(x1, y1);
  2091.                                 end;
  2092.                         end;
  2093.                     OvalRoi: 
  2094.                         FrameOval(RoiRect);
  2095.                     RectRoi: 
  2096.                         FrameRect(RoiRect);
  2097.                     otherwise
  2098.                 end;
  2099.                 CloseRgn(roiRgn);
  2100.                 if RoiType = LineRoi then begin
  2101.                         RoiRect := roiRgn^^.rgnBBox;
  2102.                         with RoiRect do begin
  2103.                                 LX1 := LX1 - left;
  2104.                                 LY1 := LY1 - top;
  2105.                                 LX2 := LX2 - left;
  2106.                                 LY2 := LY2 - top;
  2107.                             end;
  2108.                     end;
  2109.             end;
  2110.         SetPort(tPort);
  2111.     end;
  2112.  
  2113.  
  2114.     procedure SelectAll;{(visible:boolean)}
  2115.         var
  2116.             loc: point;
  2117.             tPort: GrafPtr;
  2118.     begin
  2119.         if info <> NoInfo then
  2120.             with Info^ do begin
  2121.                     KillRoi;
  2122.                     RoiType := RectRoi;
  2123.                     RoiRect := PicRect;
  2124.                     MakeRegion;
  2125.                     if visible then begin
  2126.                             SetupUndo;
  2127.                             RoiShowing := true;
  2128.                             if (magnification > 1.0) and not ScaleToFitWindow then
  2129.                                 Unzoom;
  2130.                             if not macro then begin
  2131.                                     PreviousTool := CurrentTool;
  2132.                                     CurrentTool := SelectionTool;
  2133.                                     isSelectionTool := true;
  2134.                                     GetPort(tPort);
  2135.                                     SetPort(ToolWindow);
  2136.                                     EraseRect(ToolRect[PreviousTool]);
  2137.                                     EraseRect(ToolRect[CurrentTool]);
  2138.                                     InvalRect(ToolRect[PreviousTool]);
  2139.                                     InvalRect(ToolRect[CurrentTool]);
  2140.                                     SetPort(tPort);
  2141.                                 end;
  2142.                         end;
  2143.                     IsInsertionPoint := false;
  2144.                     measuring := false;
  2145.                 end; {with}
  2146.     end;
  2147.  
  2148.  
  2149.     procedure KillOperation;
  2150.     begin
  2151.         if OpPending then
  2152.             with info^ do
  2153.                 if info <> NoInfo then begin
  2154.                         DoOperation(CurrentOp);
  2155.                         RoiShowing := false;
  2156.                         UpdateScreen(RoiRect);
  2157.                         OpPending := false;
  2158.                     end;
  2159.     end;
  2160.  
  2161.  
  2162.     procedure CloneInfo (var OldInfo, NewInfo: PicInfo);
  2163.     begin
  2164.         NewInfo := OldInfo;
  2165.         with NewInfo do begin
  2166.                 PicBaseAddr := nil;
  2167.                 PicBaseHandle := nil;
  2168.                 osPort := nil;
  2169.                 roiRgn := nil;
  2170.                 RoiType := NoRoi;
  2171.                 RoiShowing := false;
  2172.                 Magnification := 1.0;
  2173.                 vref := 0;
  2174.                 wPtr := nil;
  2175.                 ScaleToFitWindow := false;
  2176.                 WindowState := NormalWindow;
  2177.                 StackInfo := nil;
  2178.                 iversion := 0;
  2179.                 PictureType := NewPicture;
  2180.                 DataType := EightBits;
  2181.                 changes := false;
  2182.                 DataH := nil;
  2183.                 LittleEndian := false;
  2184.             end;
  2185.     end;
  2186.  
  2187.  
  2188.     function NewPicWindow (name: str255; width, height: integer): boolean;
  2189.         var
  2190.             iptr: ptr;
  2191.             lptr: ^LongInt;
  2192.             SaveInfo: InfoPtr;
  2193.             NeededSize: LongInt;
  2194.             trect: rect;
  2195.     begin
  2196.         NewPicWindow := false;
  2197.         PicLeft := PicLeftBase;
  2198.         PicTop := PicTopBase;
  2199.         if (info <> noInfo) then begin
  2200.                 with info^ do begin
  2201.                         GetWindowRect(wptr, trect);
  2202.                         if trect.left = PicLeftBase then
  2203.                             if pos('Camera', name) = 0 then begin
  2204.                                     PicLeft := trect.left + hPicOffset;
  2205.                                     PicTop := trect.top + vPicOffset;
  2206.                                 end;
  2207.                     end;
  2208.             end;
  2209.         if nPics = MaxPics then
  2210.             exit(NewPicWindow);
  2211.         KillOperation;
  2212.         DisableDensitySlice;
  2213.         SaveInfo := Info;
  2214.         iptr := NewPtr(SizeOf(PicInfo));
  2215.         if iptr = nil then begin
  2216.                 PutMemoryAlert;
  2217.                 macro := false;
  2218.                 exit(NewPicWindow);
  2219.             end;
  2220.         Info := pointer(iptr);
  2221.         CloneInfo(SaveInfo^, Info^);
  2222.         with Info^ do begin
  2223.                 nlines := height;
  2224.                 PixelsPerLine := width;
  2225.                 PicBaseAddr := GetImageMemory(SaveInfo, PicBaseHandle);
  2226.                 if PicBaseAddr = nil then
  2227.                     exit(NewPicWindow);
  2228.                 MakeNewWindow(name);
  2229.                 SelectAll(false);
  2230.                 DoOperation(EraseOp);
  2231.                 KillRoi;
  2232.                 Changes := false;
  2233.                 BinaryPic := false;
  2234.             end;
  2235.         NewPicWindow := true;
  2236.     end;
  2237.  
  2238.  
  2239.     procedure EraseScreen;
  2240.     begin
  2241.         SetPort(GrafPtr(CScreenPort));
  2242.         with CScreenPort^ do begin
  2243.                 HideCursor;
  2244.                 pmBackColor(BackgroundIndex);
  2245.                 EraseRect(portPixMap^^.Bounds);
  2246.                 pmBackColor(WhiteIndex);
  2247.             end;
  2248.     end;
  2249.  
  2250.  
  2251.     procedure RestoreScreen;
  2252.         var
  2253.             GrayRgn: RgnHandle;
  2254.             rptr: rhptr;
  2255.             wp: ^WindowPtr;
  2256.     begin
  2257.         rptr := rhptr(GrayRgnGlobal);
  2258.         GrayRgn := rptr^;
  2259.         wp := pointer(GhostWindow);
  2260.         wp^ := WindowPtr(nil);
  2261.         PaintBehind(WindowPeek(FrontWindow), GrayRgn);
  2262.         wp^ := PasteControl;
  2263.         DrawMenuBar;
  2264.     end;
  2265.  
  2266.  
  2267.     procedure UpdateTitleBar;
  2268.     {Updates the window title bar to show the current magnification or the current frame within a stack.}
  2269.         var
  2270.             str, str2, str3: str255;
  2271.     begin
  2272.         with info^ do begin
  2273.                 str := title;
  2274.                 if SpatiallyCalibrated then
  2275.                     str := concat(str, chr($13)); {Black Diamond}
  2276.                 if DensityCalibrated then
  2277.                     str := concat(str, '◊');
  2278.                 if StackInfo <> nil then
  2279.                     with StackInfo^ do begin
  2280.                             NumToString(CurrentSlice, str2);
  2281.                             NumToString(nSlices, str3);
  2282.                             str := concat(str, '(', str2, '/', str3, ')');
  2283.                         end
  2284.                 else if (magnification <> 1.0) or ScaleToFitWindow then begin
  2285.                         if ScaleToFitWindow then begin
  2286.                                 RealToString(magnification, 1, 2, str2);
  2287.                                 str := concat(str, '(', str2, ')');
  2288.                             end
  2289.                         else begin
  2290.                                 RealToString(magnification, 1, 0, str2);
  2291.                                 str := concat(str, '(', str2, ':1)');
  2292.                             end;
  2293.                     end;
  2294.                 if Digitizing then begin
  2295.                         if ExternalTrigger then
  2296.                             str := concat(str, '(Waiting for Trigger)')
  2297.                         else
  2298.                             str := concat(str, '(Live)');
  2299.                     end;
  2300.                 if wptr <> nil then
  2301.                     SetWTitle(wptr, str);
  2302.             end; {with}
  2303.     end;
  2304.  
  2305.  
  2306.     procedure ScaleToFit;
  2307.         var
  2308.             trect: rect;
  2309.     begin
  2310.         if digitizing then
  2311.             exit(ScaleToFit);
  2312.         if info <> NoInfo then
  2313.             with info^ do begin
  2314.                     ScaleToFitWindow := not ScaleToFitWindow;
  2315.                     KillRoi;
  2316.                     if ScaleToFitWindow then begin
  2317.                             savewrect := wrect;
  2318.                             SaveSrcRect := SrcRect;
  2319.                             SaveMagnification := magnification;
  2320.                             GetWindowRect(wptr, trect);
  2321.                             savehloc := trect.left;
  2322.                             savevloc := trect.top;
  2323.                             wrect := wptr^.PortRect;
  2324.                             SrcRect := PicRect;
  2325.                             ScaleImageWindow(wrect);
  2326.                             SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2327.                         end
  2328.                     else begin
  2329.                             if WindowState = TiledBigScaled then begin
  2330.                                     wrect := initwrect;
  2331.                                     SrcRect := wrect;
  2332.                                     magnification := 1.0;
  2333.                                     WindowState := NormalWindow;
  2334.                                 end
  2335.                             else begin
  2336.                                     wrect := savewrect;
  2337.                                     SrcRect := SaveSrcRect;
  2338.                                     magnification := SaveMagnification;
  2339.                                 end;
  2340.                             HideWindow(wptr);
  2341.                             SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2342.                             MoveWindow(wptr, savehloc, savevloc, true);
  2343.                             ShowWindow(wptr);
  2344.                             UpdateTitleBar;
  2345.                         end;
  2346.                     SetPort(wptr);
  2347.                     InvalRect(wrect);
  2348.                     WindowState := NormalWindow;
  2349.                 end;
  2350.     end;
  2351.  
  2352.  
  2353.     procedure DrawMyGrowIcon;{(w:WindowPtr)}
  2354.         var
  2355.             tPort: GrafPtr;
  2356.             tRect: rect;
  2357.     begin
  2358.         GetPort(tPort);
  2359.         SetPort(w);
  2360.         PenNormal;
  2361.         with w^.PortRect do begin
  2362.                 SetRect(tRect, right - 12, bottom - 12, right - 5, bottom - 5);
  2363.                 FrameRect(tRect);
  2364.                 MoveTo(right - 6, bottom - 10);
  2365.                 LineTo(right - 2, bottom - 10);
  2366.                 LineTo(right - 2, bottom - 2);
  2367.                 LineTo(right - 10, bottom - 2);
  2368.                 LineTo(right - 10, bottom - 6);
  2369.             end;
  2370.         SetPort(tPort);
  2371.     end;
  2372.  
  2373.  
  2374.     procedure Unzoom;
  2375.     begin
  2376.         if Info <> NoInfo then
  2377.             with Info^ do begin
  2378.                     if ScaleToFitWindow then
  2379.                         ScaleToFit
  2380.                     else begin
  2381.                             wrect := initwrect;
  2382.                             SrcRect := wrect;
  2383.                         end;
  2384.                     SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2385.                     LoadLUT(info^.cTable);
  2386.                     UpdatePicWindow;
  2387.                     magnification := 1.0;
  2388.                     DrawMyGrowIcon(wptr);
  2389.                     UpdateTitleBar;
  2390.                     if WhatToUndo = UndoZoom then
  2391.                         WhatToUndo := NothingToUndo;
  2392.                     ShowRoi;
  2393.                 end;
  2394.     end;
  2395.  
  2396.  
  2397.     procedure DrawBString;{(str:string)}
  2398.     begin
  2399.         TextFace([bold]);
  2400.         DrawString(str);
  2401.         TextFace([]);
  2402.     end;
  2403.  
  2404.  
  2405.     function long2str (num: LongInt): str255;
  2406.         var
  2407.             str: str255;
  2408.     begin
  2409.         NumToString(num, str);
  2410.         long2str := str;
  2411.     end;
  2412.  
  2413.  
  2414.     procedure PutWarning;
  2415.     begin
  2416.         PutMessage(concat('This ', long2str((info^.PixmapSize + 511) div 1024), 'K image is larger than the ', long2str(UndoBufSize div 1024), 'K Undo buffer. Many operations may fail or be Undoable.'));
  2417.     end;
  2418.  
  2419.  
  2420.     procedure SetupRoiRect;
  2421. {Copies the current image to Undo buffer so it can be used for drawing}
  2422. {the "marching ants". The copy of the previous image in the Clipboard buffer}
  2423. { buffer will be used for Undo.}
  2424.         var
  2425.             SaveWhatToUndo: WhatToUndoType;
  2426.     begin
  2427.         SaveWhatToUndo := WhatToUndo;
  2428.         SetupUndo;
  2429.         UndoFromClip := true;
  2430.         info^.RoiShowing := true;
  2431.         WhatToUndo := SaveWhatToUndo;
  2432.     end;
  2433.  
  2434.  
  2435.     procedure SetForegroundColor (color: integer);
  2436.         var
  2437.             tPort: GrafPtr;
  2438.     begin
  2439.         if (color >= 0) and (color <= 255) then
  2440.             with info^ do begin
  2441.                     ForegroundIndex := color;
  2442.                     GetPort(tPort);
  2443.                     SetPort(ToolWindow);
  2444.                     InvalRect(ToolRect[brush]);
  2445.                     if osPort <> nil then begin
  2446.                             SetPort(GrafPtr(osPort));
  2447.                             pmForeColor(ForegroundIndex);
  2448.                         end;
  2449.                     SetPort(tPort);
  2450.                     if isInsertionPoint then
  2451.                         DisplayText(true);
  2452.                 end;
  2453.     end;
  2454.  
  2455.  
  2456.     procedure SetBackgroundColor (color: integer);
  2457.         var
  2458.             tPort: GrafPtr;
  2459.     begin
  2460.         if (color >= 0) and (color <= 255) then
  2461.             with info^ do begin
  2462.                     BackgroundIndex := color;
  2463.                     GetPort(tPort);
  2464.                     SetPort(ToolWindow);
  2465.                     InvalRect(ToolRect[eraser]);
  2466.                     if osPort <> nil then begin
  2467.                             SetPort(GrafPtr(osPort));
  2468.                             pmBackColor(BackgroundIndex);
  2469.                         end;
  2470.                     SetPort(tPort);
  2471.                     if isInsertionPoint then
  2472.                         DisplayText(true);
  2473.                 end;
  2474.     end;
  2475.  
  2476.  
  2477.     procedure GetForegroundColor;{(event: EventRecord)}
  2478.         var
  2479.             loc: point;
  2480.             color: integer;
  2481.     begin
  2482.         loc := event.where;
  2483.         ScreenToOffScreen(loc);
  2484.         Color := MyGetPixel(loc.h, loc.v);
  2485.         SetForegroundColor(color);
  2486.     end;
  2487.  
  2488.  
  2489.     procedure GetBackgroundColor; {(event: EventRecord)}
  2490.         var
  2491.             loc: point;
  2492.             color: integer;
  2493.     begin
  2494.         loc := event.where;
  2495.         ScreenToOffScreen(loc);
  2496.         Color := MyGetPixel(loc.h, loc.v);
  2497.         SetBackgroundColor(color);
  2498.     end;
  2499.  
  2500.  
  2501.     procedure GenerateValues;
  2502.         var
  2503.             a, b, c, d, e, f, x, y: extended;
  2504.             i: integer;
  2505.     begin
  2506.         with info^ do begin
  2507.                 if not DensityCalibrated then begin
  2508.                         for i := 0 to 255 do
  2509.                             cvalue[i] := i;
  2510.                         MinValue := 0.0;
  2511.                         MaxValue := 255.0;
  2512.                         exit(GenerateValues);
  2513.                     end;
  2514.                 a := Coefficient[1];
  2515.                 b := Coefficient[2];
  2516.                 c := Coefficient[3];
  2517.                 d := Coefficient[4];
  2518.                 e := Coefficient[5];
  2519.                 f := Coefficient[6];
  2520.                 MinValue := 10e+12;
  2521.                 MaxValue := -MinValue;
  2522.                 for i := 0 to 255 do begin
  2523.                         x := i;
  2524.                         case fit of
  2525.                             StraightLine: 
  2526.                                 y := a + b * x;
  2527.                             Poly2: 
  2528.                                 y := a + b * x + c * x * x;
  2529.                             Poly3: 
  2530.                                 y := a + b * x + c * x * x + d * x * x * x;
  2531.                             Poly4: 
  2532.                                 y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x;
  2533.                             Poly5: 
  2534.                                 y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x + f * x * x * x * x * x;
  2535.                             ExpoFit: 
  2536.                                 y := a * exp(b * x);
  2537.                             PowerFit: 
  2538.                                 if x = 0.0 then
  2539.                                     y := 0.0
  2540.                                 else
  2541.                                     y := a * exp(b * ln(x)); {y=ax^b}
  2542.                             LogFit:  begin
  2543.                                     if x = 0.0 then
  2544.                                         x := 0.5;
  2545.                                     y := a * ln(b * x)
  2546.                                 end;
  2547.                             RodbardFit:  begin
  2548.                                     if x <= a then
  2549.                                         y := 0
  2550.                                     else begin
  2551.                                             y := (a - x) / (x - d);
  2552.                                             y := exp(ln(y) * (1 / b));  {y:=y**(1/b)}
  2553.                                             y := y * c;
  2554.                                         end;
  2555.                                 end;
  2556.                             UncalibratedOD:  begin
  2557.                                     if x = 255.0 then
  2558.                                         x := 254.5;
  2559.                                     y := 0.434294481 * ln(255 / (255 - x))  {log10}
  2560.                                 end;
  2561.                             otherwise
  2562.                                 y := x;
  2563.                         end; {case}
  2564.                         cvalue[i] := y;
  2565.                         if y > MaxValue then
  2566.                             MaxValue := y;
  2567.                         if y < MinValue then
  2568.                             MinValue := y;
  2569.                     end; {for}
  2570.                 if MinValue >= 0.0 then
  2571.                     ZeroClip := false;
  2572.                 if ZeroClip then begin
  2573.                         for i := 0 to 255 do
  2574.                             if cvalue[i] < 0.0 then
  2575.                                 cvalue[i] := 0.0;
  2576.                         MinValue := 0.0;
  2577.                     end;
  2578.             end;
  2579.     end;
  2580.  
  2581.  
  2582.     procedure ScaleImageWindow (var trect: rect);
  2583.         var
  2584.             WindowLeft, WindowTop: integer;
  2585.             PicAspectRatio, TempMagnification: extended;
  2586.     begin
  2587.         with info^ do begin
  2588.                 SrcRect := PicRect;
  2589.                 with CGrafPort(wptr^).PortPixMap^^.bounds do begin
  2590.                         WindowLeft := -left;
  2591.                         WindowTop := -top;
  2592.                     end;
  2593.                 with PicRect do
  2594.                     PicAspectRatio := right / bottom;
  2595.                 with trect do begin
  2596.                         if (WindowLeft + right) > (ScreenWidth - 5) then
  2597.                             right := ScreenWidth - 5 - WindowLeft;
  2598.                         bottom := round(right / PicAspectRatio);
  2599.                         if (WindowTop + bottom) > (ScreenHeight - 5) then
  2600.                             bottom := ScreenHeight - 5 - WindowTop;
  2601.                         right := round(bottom * PicAspectRatio);
  2602.                         magnification := right / PicRect.right;
  2603.                     end;
  2604.                 UpdateTitleBar;
  2605.             end; {with}
  2606.     end;
  2607.  
  2608.  
  2609.     function TooWide: boolean;
  2610.         var
  2611.             SelectionTooWide: boolean;
  2612.             MaxWidth: str255;
  2613.     begin
  2614.         with info^.RoiRect do
  2615.             SelectionTooWide := (right - left) > MaxLine;
  2616.         if SelectionTooWide then begin
  2617.                 NumToString(MaxLine, MaxWidth);
  2618.                 PutMessage(concat('This operation does not support selections wider than ', MaxWidth, ' pixels.'));
  2619.                 macro := false;
  2620.             end;
  2621.         TooWide := SelectionTooWide;
  2622.     end;
  2623.  
  2624.  
  2625.     procedure DrawTextString (str: str255; loc: point; just: integer);
  2626.         var
  2627.             SaveJust: integer;
  2628.     begin
  2629.         TextStr := str;
  2630.         IsInsertionPoint := true;
  2631.         TextStart := loc;
  2632.         SaveJust := TextJust;
  2633.         TextJust := just;
  2634.         DisplayText(false);
  2635.         TextJust := SaveJust;
  2636.         IsInsertionPoint := false;
  2637.     end;
  2638.  
  2639.  
  2640.     procedure IncrementCounter;
  2641.     begin
  2642.         if mCount < MaxMeasurements then begin
  2643.                 mCount := mCount + 1;
  2644.                 UnsavedResults := true;
  2645.             end
  2646.         else
  2647.             beep;
  2648.     end;
  2649.  
  2650.  
  2651.     procedure ClearResults (i: integer);
  2652.     begin
  2653.         mean^[i] := 0.0;
  2654.         sd^[i] := 0.0;
  2655.         PixelCount^[i] := 0;
  2656.         mArea^[i] := 0.0;
  2657.         mode^[i] := 0.0;
  2658.         IntegratedDensity^[i] := 0.0;
  2659.         idBackground^[i] := 0.0;
  2660.         xcenter^[i] := 0.0;
  2661.         ycenter^[i] := 0.0;
  2662.         MajorAxis^[i] := 0.0;
  2663.         MinorAxis^[i] := 0.0;
  2664.         orientation^[i] := 0.0;
  2665.         mMin^[i] := 0.0;
  2666.         mMax^[i] := 0.0;
  2667.         plength^[i] := 0.0;
  2668.     end;
  2669.  
  2670.     procedure UpdateFitEllipse;
  2671.     begin
  2672.         FitEllipse := (xyLocM in measurements) or (MajorAxisM in measurements) or (MinorAxisM in measurements) or (AngleM in measurements);
  2673.     end;
  2674.  
  2675.  
  2676.  
  2677. {$POP}
  2678.  
  2679.     function StringToReal (str: str255): extended;
  2680.         var
  2681.             i, ndigits, StringLength: integer;
  2682.             c: char;
  2683.             n, m: extended;
  2684.             negative, LeftOfPoint, NegExp: boolean;
  2685.             exponent: LongInt;
  2686.     begin
  2687.         negative := false;
  2688.         n := 0.0;
  2689.         LeftOfPoint := true;
  2690.         m := 0.1;
  2691.         ndigits := 0;
  2692.         StringLength := length(str);
  2693.         i := 0;
  2694.         repeat
  2695.             i := i + 1;
  2696.         until (str[i] in ['0'..'9', '-', '.']) or (i >= StringLength);
  2697.         c := str[i];
  2698.         repeat
  2699.             if c = '-' then
  2700.                 negative := true
  2701.             else if c = '.' then
  2702.                 LeftOfPoint := false
  2703.             else if (c >= '0') and (c <= '9') then begin
  2704.                     ndigits := ndigits + 1;
  2705.                     if LeftOfPoint then
  2706.                         n := n * 10.0 + ord(c) - ord('0')
  2707.                     else begin
  2708.                             n := n + (ord(c) - ord('0')) * m;
  2709.                             m := m * 0.1;
  2710.                         end;
  2711.                 end;
  2712.             i := i + 1;
  2713.             if i <= StringLength then
  2714.                 c := str[i];
  2715.         until not (c in ['0'..'9', '-', '.']) or (i > StringLength);
  2716.         if (c = 'e') or (c = 'E') then begin
  2717.                 NegExp := false;
  2718.                 exponent := 0;
  2719.                 i := i + 1;
  2720.                 if i <= StringLength then
  2721.                     c := str[i];
  2722.                 if (c = '+') or (c = '-') then begin
  2723.                         if c = '-' then
  2724.                             NegExp := true;
  2725.                         i := i + 1;
  2726.                         if i <= StringLength then
  2727.                             c := str[i];
  2728.                     end;
  2729.                 repeat
  2730.                     if (c >= '0') and (c <= '9') then
  2731.                         exponent := exponent * 10 + ord(c) - ord('0');
  2732.                     i := i + 1;
  2733.                     if i <= StringLength then
  2734.                         c := str[i];
  2735.                 until not (c in ['0'..'9']) or (i > StringLength);
  2736.                 if negExp then
  2737.                     exponent := -exponent;
  2738.                 if exponent <> 0 then
  2739.                     n := n * exp(exponent * ln(10));
  2740.             end; {if c='e'}
  2741.         if ndigits = 0 then
  2742.             n := BadReal
  2743.         else if negative then
  2744.             n := -n;
  2745.         StringToReal := n;
  2746.     end;
  2747.  
  2748.  
  2749.     procedure MakeNewWindow;{(name:str255)}
  2750.         var
  2751.             wwidth, wheight, wleft, wtop, i: integer;
  2752.             tPort: GrafPtr;
  2753.             rgb: RGBColor;
  2754.             err: OSErr;
  2755.             str: str255;
  2756.             SaveDevice: GDHandle;
  2757.     begin
  2758.         with Info^ do begin
  2759.                 wleft := PicLeft;
  2760.                 wtop := PicTop;
  2761.                 PicLeft := PicLeft + hPicOffset;
  2762.                 PicTop := PicTop + vPicOffset;
  2763.                 if ((PicLeft + round(0.75 * PixelsPerLine)) > ScreenWidth) or ((PicTop + round(0.75 * nlines)) > ScreenHeight) then begin
  2764.                         PicLeft := PicLeftBase;
  2765.                         PicTop := PicTopBase;
  2766.                     end;
  2767.                 wwidth := PixelsPerLine;
  2768.                 if (wleft + wwidth) > ScreenWidth then
  2769.                     wwidth := ScreenWidth - wleft - 4;
  2770.                 wheight := nlines;
  2771.                 if (wtop + wheight) > ScreenHeight then
  2772.                     wheight := ScreenHeight - wtop - 4;
  2773.                 if OpeningPlugInWindow then
  2774.                     SetRect(wrect, -10000, wtop, -10000 + wwidth, wtop + wheight)
  2775.                 else
  2776.                     SetRect(wrect, wleft, wtop, wleft + wwidth, wtop + wheight);
  2777.                 str := name;
  2778.                 if SpatiallyCalibrated then
  2779.                     str := concat(str, chr($13)); {Black Diamond}
  2780.                 if DensityCalibrated then
  2781.                     str := concat(str, '◊');
  2782.                 wptr := NewCWindow(nil, wrect, str, true, DocumentProc + ZoomDocProc, nil, true, 0);
  2783.                 GetPort(tPort);
  2784.                 SetPort(wptr);
  2785.                 SetPalette(wptr, ExplicitPalette, false);
  2786.                 pmForeColor(BlackIndex);
  2787.                 pmBackColor(WhiteIndex);
  2788.                 SetRect(wrect, 0, 0, wwidth, wheight);
  2789.                 SetRect(PicRect, 0, 0, PixelsPerLine, nlines);
  2790.                 SelectWindow(wptr);
  2791.                 WindowPeek(wptr)^.WindowKind := PicKind;
  2792.                 WindowPeek(wptr)^.RefCon := ord4(Info);
  2793.                 title := name;
  2794.                 ExtendWindowsMenu(name, PixMapSize, wptr);
  2795.                 PicNum := nPics;
  2796.                 PidNum := nextPid;
  2797.                 nextPid := nextPid - 1;
  2798.                 osPort := CGrafPtr(NewPtr(SizeOf(CGrafPort)));
  2799. {SaveDevice := GetGDevice;}
  2800. {SetGDevice(osGDevice);}
  2801.                 OpenCPort(osPort);
  2802.                 with osPort^ do begin
  2803.                         with PortPixMap^^ do begin
  2804.                                 BaseAddr := PicBaseAddr;
  2805.                                 bounds := PicRect;
  2806.                                 pixelType := 0;
  2807.                                 if PixelSize > 8 then
  2808.                                     PixelSize := 8;
  2809.                                 cmpCount := 1;
  2810.                             end;
  2811.                         PortRect := PicRect;
  2812.                         RectRgn(visRgn, PicRect);
  2813.                         PortPixMap^^.RowBytes := BitOr(BytesPerRow, $8000);
  2814.                     end;
  2815.                 SetPalette(WindowPtr(osPort), ExplicitPalette, false);
  2816.                 pmForeColor(ForegroundIndex);
  2817.                 pmBackColor(BackgroundIndex);
  2818. {SetGDevice(SaveDevice);}
  2819.                 SetPort(tPort);
  2820.                 SrcRect := wrect;
  2821.                 magnification := 1.0;
  2822.                 RoiShowing := false;
  2823.                 roiType := NoRoi;
  2824.                 initwrect := wrect;
  2825.                 savewrect := wrect;
  2826.                 SaveSrcRect := SrcRect;
  2827.                 SaveMagnification := magnification;
  2828.                 savehloc := wleft;
  2829.                 savevloc := wtop;
  2830.                 roiRgn := NewRgn;
  2831.                 NewPic := true;
  2832.                 ScaleToFitWindow := false;
  2833.                 OpPending := false;
  2834.                 Changes := false;
  2835.                 WindowState := NormalWindow;
  2836.                 if not DensityCalibrated and InvertPixelValues then
  2837.                     InvertGrayLevels;
  2838.                 Revertable := false;
  2839.             end;
  2840.         WhatToUndo := NothingToUndo;
  2841.     end;
  2842.  
  2843.  
  2844.     procedure MakeLowerCase (var str: str255);
  2845.         var
  2846.             i: integer;
  2847.             c: char;
  2848.     begin
  2849.         for i := 1 to length(str) do begin
  2850.                 c := str[i];
  2851.                 if (c >= 'A') and (c <= 'Z') then
  2852.                     str[i] := chr(ord(c) + 32);
  2853.             end;
  2854.     end;
  2855.  
  2856.  
  2857.     function PutMessageWithCancel (str: str255): integer;
  2858.     begin
  2859.         InitCursor;
  2860.         ParamText(str, '', '', '');
  2861.         PutMessageWithCancel := Alert(800, nil);
  2862.     end;
  2863.  
  2864.  
  2865.     function CurrentWindow: integer;
  2866.     begin
  2867.         CurrentWPtr := FrontWindow;
  2868.         if CurrentWPtr <> nil then begin
  2869.                 CurrentKind := WindowPeek(CurrentWPtr)^.WindowKind;
  2870.                 if CurrentKind = TextKind then
  2871.                     TextInfo := TextInfoPtr(WindowPeek(CurrentWPtr)^.RefCon);
  2872.                 CurrentWindow := CurrentKind;
  2873.             end
  2874.         else begin
  2875.                 CurrentWindow := 0;
  2876.                 CurrentKind := 0;
  2877.             end;
  2878.     end;
  2879.  
  2880.  
  2881. end.